xref: /petsc/src/sys/error/fp.c (revision e547316f4402a1e200825e67112b0ad01f5d0e03)
1e5c89e4eSSatish Balay #define PETSC_DLL
2e5c89e4eSSatish Balay /*
3e5c89e4eSSatish Balay *	IEEE error handler for all machines. Since each machine 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 */
15*e547316fSJed Brown #ifndef _GNU_SOURCE
16b014e56cSJed Brown #define _GNU_SOURCE
17b014e56cSJed Brown 
18d382aafbSBarry Smith #include "petscsys.h"           /*I  "petscsys.h"  I*/
19e5c89e4eSSatish Balay #include <signal.h>
20e5c89e4eSSatish Balay #if defined(PETSC_HAVE_STDLIB_H)
21e5c89e4eSSatish Balay #include <stdlib.h>
22e5c89e4eSSatish Balay #endif
23e5c89e4eSSatish Balay 
24e5c89e4eSSatish Balay /*--------------------------------------- ---------------------------------------------------*/
25e5c89e4eSSatish Balay #if defined(PETSC_HAVE_SUN4_STYLE_FPTRAP)
26e5c89e4eSSatish Balay #include <floatingpoint.h>
27e5c89e4eSSatish Balay 
28e5c89e4eSSatish Balay EXTERN_C_BEGIN
29e5c89e4eSSatish Balay PetscErrorCode ieee_flags(char*,char*,char*,char**);
30e5c89e4eSSatish Balay PetscErrorCode ieee_handler(char *,char *,sigfpe_handler_type(int,int,struct sigcontext*,char *));
31e5c89e4eSSatish Balay EXTERN_C_END
32e5c89e4eSSatish Balay 
33db32a245SJed Brown static struct { int code_no; char *name; } error_codes[] = {
34e5c89e4eSSatish Balay            { FPE_INTDIV_TRAP	,"integer divide" },
35e5c89e4eSSatish Balay 	   { FPE_FLTOPERR_TRAP	,"IEEE operand error" },
36e5c89e4eSSatish Balay 	   { FPE_FLTOVF_TRAP	,"floating point overflow" },
37e5c89e4eSSatish Balay 	   { FPE_FLTUND_TRAP	,"floating point underflow" },
38e5c89e4eSSatish Balay 	   { FPE_FLTDIV_TRAP	,"floating pointing divide" },
39e5c89e4eSSatish Balay 	   { FPE_FLTINEX_TRAP	,"inexact floating point result" },
40e5c89e4eSSatish Balay 	   { 0			,"unknown error" }
41e5c89e4eSSatish Balay } ;
42e5c89e4eSSatish Balay #define SIGPC(scp) (scp->sc_pc)
43e5c89e4eSSatish Balay 
44e5c89e4eSSatish Balay #undef __FUNCT__
45e5c89e4eSSatish Balay #define __FUNCT__ "PetscDefaultFPTrap"
46e5c89e4eSSatish Balay sigfpe_handler_type PetscDefaultFPTrap(int sig,int code,struct sigcontext *scp,char *addr)
47e5c89e4eSSatish Balay {
48e5c89e4eSSatish Balay   PetscErrorCode ierr;
49e5c89e4eSSatish Balay   int err_ind = -1,j;
50e5c89e4eSSatish Balay 
51e5c89e4eSSatish Balay   PetscFunctionBegin;
52e5c89e4eSSatish Balay   for (j = 0 ; error_codes[j].code_no ; j++) {
53e5c89e4eSSatish Balay     if (error_codes[j].code_no == code) err_ind = j;
54e5c89e4eSSatish Balay   }
55e5c89e4eSSatish Balay 
56e5c89e4eSSatish Balay   if (err_ind >= 0) {
57e5c89e4eSSatish Balay     (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n",error_codes[err_ind].name,SIGPC(scp));
58e5c89e4eSSatish Balay   } else {
59e5c89e4eSSatish Balay     (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n",code,SIGPC(scp));
60e5c89e4eSSatish Balay   }
61e32f2f54SBarry Smith   ierr = PetscError(PETSC_COMM_SELF,PETSC_ERR_FP,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
62e5c89e4eSSatish Balay   MPI_Abort(PETSC_COMM_WORLD,0);
63e5c89e4eSSatish Balay   PetscFunctionReturn(0);
64e5c89e4eSSatish Balay }
65e5c89e4eSSatish Balay 
66e5c89e4eSSatish Balay #undef __FUNCT__
67e5c89e4eSSatish Balay #define __FUNCT__ "PetscSetFPTrap"
68e30d2299SSatish Balay /*@
69e5c89e4eSSatish Balay    PetscSetFPTrap - Enables traps/exceptions on common floating point errors.
70e5c89e4eSSatish Balay                     This option may not work on certain machines.
71e5c89e4eSSatish Balay 
72e5c89e4eSSatish Balay    Not Collective
73e5c89e4eSSatish Balay 
74e5c89e4eSSatish Balay    Input Parameters:
75e5c89e4eSSatish Balay .  flag - PETSC_FP_TRAP_ON, PETSC_FP_TRAP_OFF.
76e5c89e4eSSatish Balay 
77e5c89e4eSSatish Balay    Options Database Keys:
78e5c89e4eSSatish Balay .  -fp_trap - Activates floating point trapping
79e5c89e4eSSatish Balay 
80e5c89e4eSSatish Balay    Level: advanced
81e5c89e4eSSatish Balay 
82e5c89e4eSSatish Balay    Description:
83e5c89e4eSSatish Balay    On systems that support it, this routine causes floating point
84e5c89e4eSSatish Balay    overflow, divide-by-zero, and invalid-operand (e.g., a NaN) to
85e5c89e4eSSatish Balay    cause a message to be printed and the program to exit.
86e5c89e4eSSatish Balay 
877d125cddSJed Brown    Note:
887d125cddSJed Brown    On many common systems including x86 and x86-64 Linux, the floating
897d125cddSJed Brown    point exception state is not preserved from the location where the trap
907d125cddSJed Brown    occurred through to the signal handler.  In this case, the signal handler
917d125cddSJed Brown    will just say that an unknown floating point exception occurred and which
927d125cddSJed Brown    function it occurred in.  If you run with -fp_trap in a debugger, it will
937d125cddSJed Brown    break on the line where the error occurred.  You can check which
947d125cddSJed Brown    exception occurred using fetestexcept(FE_ALL_EXCEPT).  See fenv.h
957d125cddSJed Brown    (usually at /usr/include/bits/fenv.h) for the enum values on your system.
967d125cddSJed Brown 
97e5c89e4eSSatish Balay    Caution:
98e5c89e4eSSatish Balay    On certain machines, in particular the IBM rs6000, floating point
99e5c89e4eSSatish Balay    trapping is VERY slow!
100e5c89e4eSSatish Balay 
101e5c89e4eSSatish Balay    Concepts: floating point exceptions^trapping
102e5c89e4eSSatish Balay    Concepts: divide by zero
103e5c89e4eSSatish Balay 
104e5c89e4eSSatish Balay @*/
105e5c89e4eSSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
106e5c89e4eSSatish Balay {
107e5c89e4eSSatish Balay   char *out;
108e5c89e4eSSatish Balay 
109e5c89e4eSSatish Balay   PetscFunctionBegin;
110e5c89e4eSSatish Balay   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
111e5c89e4eSSatish Balay   (void) ieee_flags("clear","exception","all",&out);
112e5c89e4eSSatish Balay   if (flag == PETSC_FP_TRAP_ON) {
113e5c89e4eSSatish Balay     if (ieee_handler("set","common",PetscDefaultFPTrap)) {
114e5c89e4eSSatish Balay       /*
115e5c89e4eSSatish Balay         To trap more fp exceptions, including undrflow, change the above line to
116e5c89e4eSSatish Balay         if (ieee_handler("set","all",PetscDefaultFPTrap)) {
117e5c89e4eSSatish Balay       */
118e5c89e4eSSatish Balay       (*PetscErrorPrintf)("Can't set floatingpoint handler\n");
119e5c89e4eSSatish Balay     }
120e5c89e4eSSatish Balay   } else {
121e5c89e4eSSatish Balay     if (ieee_handler("clear","common",PetscDefaultFPTrap)) {
122e5c89e4eSSatish Balay       (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
123e5c89e4eSSatish Balay     }
124e5c89e4eSSatish Balay   }
125e5c89e4eSSatish Balay   PetscFunctionReturn(0);
126e5c89e4eSSatish Balay }
127e5c89e4eSSatish Balay 
128e5c89e4eSSatish Balay /* -------------------------------------------------------------------------------------------*/
129e5c89e4eSSatish Balay #elif defined(PETSC_HAVE_SOLARIS_STYLE_FPTRAP)
130e5c89e4eSSatish Balay #include <sunmath.h>
131e5c89e4eSSatish Balay #include <floatingpoint.h>
132e5c89e4eSSatish Balay #include <siginfo.h>
133e5c89e4eSSatish Balay #include <ucontext.h>
134e5c89e4eSSatish Balay 
135db32a245SJed Brown static struct { int code_no; char *name; } error_codes[] = {
136e5c89e4eSSatish Balay   {  FPE_FLTINV,"invalid floating point operand"},
137e5c89e4eSSatish Balay   {  FPE_FLTRES,"inexact floating point result"},
138e5c89e4eSSatish Balay   {  FPE_FLTDIV,"division-by-zero"},
139e5c89e4eSSatish Balay   {  FPE_FLTUND,"floating point underflow"},
140e5c89e4eSSatish Balay   {  FPE_FLTOVF,"floating point overflow"},
141e5c89e4eSSatish Balay   {  0,         "unknown error"}
142e5c89e4eSSatish Balay };
143e5c89e4eSSatish Balay #define SIGPC(scp) (scp->si_addr)
144e5c89e4eSSatish Balay 
145e5c89e4eSSatish Balay #undef __FUNCT__
146e5c89e4eSSatish Balay #define __FUNCT__ "PetscDefaultFPTrap"
147e5c89e4eSSatish Balay void PetscDefaultFPTrap(int sig,siginfo_t *scp,ucontext_t *uap)
148e5c89e4eSSatish Balay {
149e5c89e4eSSatish Balay   int err_ind,j,code = scp->si_code;
150e5c89e4eSSatish Balay   PetscErrorCode ierr;
151e5c89e4eSSatish Balay 
152e5c89e4eSSatish Balay   PetscFunctionBegin;
153e5c89e4eSSatish Balay   err_ind = -1 ;
154e5c89e4eSSatish Balay   for (j = 0 ; error_codes[j].code_no ; j++) {
155e5c89e4eSSatish Balay     if (error_codes[j].code_no == code) err_ind = j;
156e5c89e4eSSatish Balay   }
157e5c89e4eSSatish Balay 
158e5c89e4eSSatish Balay   if (err_ind >= 0) {
159e5c89e4eSSatish Balay     (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n",error_codes[err_ind].name,SIGPC(scp));
160e5c89e4eSSatish Balay   } else {
161e5c89e4eSSatish Balay     (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n",code,SIGPC(scp));
162e5c89e4eSSatish Balay   }
163e32f2f54SBarry Smith   ierr = PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
164e5c89e4eSSatish Balay   MPI_Abort(PETSC_COMM_WORLD,0);
165e5c89e4eSSatish Balay }
166e5c89e4eSSatish Balay 
167e5c89e4eSSatish Balay #undef __FUNCT__
168e5c89e4eSSatish Balay #define __FUNCT__ "PetscSetFPTrap"
169e5c89e4eSSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
170e5c89e4eSSatish Balay {
171e5c89e4eSSatish Balay   char *out;
172e5c89e4eSSatish Balay 
173e5c89e4eSSatish Balay   PetscFunctionBegin;
174e5c89e4eSSatish Balay   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
175e5c89e4eSSatish Balay   (void) ieee_flags("clear","exception","all",&out);
176e5c89e4eSSatish Balay   if (flag == PETSC_FP_TRAP_ON) {
177e5c89e4eSSatish Balay     if (ieee_handler("set","common",(sigfpe_handler_type)PetscDefaultFPTrap)) {
178e5c89e4eSSatish Balay       (*PetscErrorPrintf)("Can't set floating point handler\n");
179e5c89e4eSSatish Balay     }
180e5c89e4eSSatish Balay   } else {
181e5c89e4eSSatish Balay     if (ieee_handler("clear","common",(sigfpe_handler_type)PetscDefaultFPTrap)) {
182e5c89e4eSSatish Balay      (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
183e5c89e4eSSatish Balay     }
184e5c89e4eSSatish Balay   }
185e5c89e4eSSatish Balay   PetscFunctionReturn(0);
186e5c89e4eSSatish Balay }
187e5c89e4eSSatish Balay 
188e5c89e4eSSatish Balay /* ------------------------------------------------------------------------------------------*/
189e5c89e4eSSatish Balay 
190e5c89e4eSSatish Balay #elif defined (PETSC_HAVE_IRIX_STYLE_FPTRAP)
191e5c89e4eSSatish Balay #include <sigfpe.h>
192db32a245SJed Brown static struct { int code_no; char *name; } error_codes[] = {
193e5c89e4eSSatish Balay        { _INVALID   ,"IEEE operand error" },
194e5c89e4eSSatish Balay        { _OVERFL    ,"floating point overflow" },
195e5c89e4eSSatish Balay        { _UNDERFL   ,"floating point underflow" },
196e5c89e4eSSatish Balay        { _DIVZERO   ,"floating point divide" },
197e5c89e4eSSatish Balay        { 0          ,"unknown error" }
198e5c89e4eSSatish Balay } ;
199e5c89e4eSSatish Balay #undef __FUNCT__
200e5c89e4eSSatish Balay #define __FUNCT__ "PetscDefaultFPTrap"
201e5c89e4eSSatish Balay void PetscDefaultFPTrap(unsigned exception[],int val[])
202e5c89e4eSSatish Balay {
203e5c89e4eSSatish Balay   int err_ind,j,code;
204e5c89e4eSSatish Balay 
205e5c89e4eSSatish Balay   PetscFunctionBegin;
206e5c89e4eSSatish Balay   code = exception[0];
207e5c89e4eSSatish Balay   err_ind = -1 ;
208e5c89e4eSSatish Balay   for (j = 0 ; error_codes[j].code_no ; j++){
209e5c89e4eSSatish Balay     if (error_codes[j].code_no == code) err_ind = j;
210e5c89e4eSSatish Balay   }
211e5c89e4eSSatish Balay   if (err_ind >= 0){
212e5c89e4eSSatish Balay     (*PetscErrorPrintf)("*** %s occurred ***\n",error_codes[err_ind].name);
213e5c89e4eSSatish Balay   } else{
214e5c89e4eSSatish Balay     (*PetscErrorPrintf)("*** floating point error 0x%x occurred ***\n",code);
215e5c89e4eSSatish Balay   }
216e32f2f54SBarry Smith   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
217e5c89e4eSSatish Balay   MPI_Abort(PETSC_COMM_WORLD,0);
218e5c89e4eSSatish Balay }
219e5c89e4eSSatish Balay 
220e5c89e4eSSatish Balay #undef __FUNCT__
221e5c89e4eSSatish Balay #define __FUNCT__ "PetscSetFPTrap"
222e5c89e4eSSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
223e5c89e4eSSatish Balay {
224e5c89e4eSSatish Balay   PetscFunctionBegin;
225e5c89e4eSSatish Balay   if (flag == PETSC_FP_TRAP_ON) {
226e5c89e4eSSatish Balay     handle_sigfpes(_ON,_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,PetscDefaultFPTrap,_ABORT_ON_ERROR,0);
227e5c89e4eSSatish Balay   } else {
228e5c89e4eSSatish Balay     handle_sigfpes(_OFF,_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,0,_ABORT_ON_ERROR,0);
229e5c89e4eSSatish Balay   }
230e5c89e4eSSatish Balay   PetscFunctionReturn(0);
231e5c89e4eSSatish Balay }
232e5c89e4eSSatish Balay /*----------------------------------------------- --------------------------------------------*/
233e5c89e4eSSatish Balay /* In "fast" mode, floating point traps are imprecise and ignored.
234e5c89e4eSSatish Balay    This is the reason for the fptrap(FP_TRAP_SYNC) call */
235e5c89e4eSSatish Balay #elif defined(PETSC_HAVE_RS6000_STYLE_FPTRAP)
236e5c89e4eSSatish Balay struct sigcontext;
237e5c89e4eSSatish Balay #include <fpxcp.h>
238e5c89e4eSSatish Balay #include <fptrap.h>
239e5c89e4eSSatish Balay #include <stdlib.h>
240e5c89e4eSSatish Balay #define FPE_FLTOPERR_TRAP (fptrap_t)(0x20000000)
241e5c89e4eSSatish Balay #define FPE_FLTOVF_TRAP   (fptrap_t)(0x10000000)
242e5c89e4eSSatish Balay #define FPE_FLTUND_TRAP   (fptrap_t)(0x08000000)
243e5c89e4eSSatish Balay #define FPE_FLTDIV_TRAP   (fptrap_t)(0x04000000)
244e5c89e4eSSatish Balay #define FPE_FLTINEX_TRAP  (fptrap_t)(0x02000000)
245e5c89e4eSSatish Balay 
246db32a245SJed Brown static struct { int code_no; char *name; } error_codes[] = {
247e5c89e4eSSatish Balay            {FPE_FLTOPERR_TRAP	,"IEEE operand error" },
248e5c89e4eSSatish Balay 	   { FPE_FLTOVF_TRAP	,"floating point overflow" },
249e5c89e4eSSatish Balay 	   { FPE_FLTUND_TRAP	,"floating point underflow" },
250e5c89e4eSSatish Balay 	   { FPE_FLTDIV_TRAP	,"floating point divide" },
251e5c89e4eSSatish Balay 	   { FPE_FLTINEX_TRAP	,"inexact floating point result" },
252e5c89e4eSSatish Balay 	   { 0			,"unknown error" }
253e5c89e4eSSatish Balay } ;
254e5c89e4eSSatish Balay #define SIGPC(scp) (0) /* Info MIGHT be in scp->sc_jmpbuf.jmp_context.iar */
255e5c89e4eSSatish Balay /*
256e5c89e4eSSatish Balay    For some reason, scp->sc_jmpbuf does not work on the RS6000, even though
257e5c89e4eSSatish Balay    it looks like it should from the include definitions.  It is probably
258e5c89e4eSSatish Balay    some strange interaction with the "POSIX_SOURCE" that we require.
259e5c89e4eSSatish Balay */
260e5c89e4eSSatish Balay 
261e5c89e4eSSatish Balay #undef __FUNCT__
262e5c89e4eSSatish Balay #define __FUNCT__ "PetscDefaultFPTrap"
263e5c89e4eSSatish Balay void PetscDefaultFPTrap(int sig,int code,struct sigcontext *scp)
264e5c89e4eSSatish Balay {
265e5c89e4eSSatish Balay   PetscErrorCode ierr;
266e5c89e4eSSatish Balay   int      err_ind,j;
267e5c89e4eSSatish Balay   fp_ctx_t flt_context;
268e5c89e4eSSatish Balay 
269e5c89e4eSSatish Balay   PetscFunctionBegin;
270e5c89e4eSSatish Balay   fp_sh_trap_info(scp,&flt_context);
271e5c89e4eSSatish Balay 
272e5c89e4eSSatish Balay   err_ind = -1 ;
273e5c89e4eSSatish Balay   for (j = 0 ; error_codes[j].code_no ; j++) {
274e5c89e4eSSatish Balay     if (error_codes[j].code_no == flt_context.trap) err_ind = j;
275e5c89e4eSSatish Balay   }
276e5c89e4eSSatish Balay 
277e5c89e4eSSatish Balay   if (err_ind >= 0){
278e5c89e4eSSatish Balay     (*PetscErrorPrintf)("*** %s occurred ***\n",error_codes[err_ind].name);
279e5c89e4eSSatish Balay   } else{
280e5c89e4eSSatish Balay     (*PetscErrorPrintf)("*** floating point error 0x%x occurred ***\n",flt_context.trap);
281e5c89e4eSSatish Balay   }
282e32f2f54SBarry Smith   ierr = PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
283e5c89e4eSSatish Balay   MPI_Abort(PETSC_COMM_WORLD,0);
284e5c89e4eSSatish Balay }
285e5c89e4eSSatish Balay 
286e5c89e4eSSatish Balay #undef __FUNCT__
287e5c89e4eSSatish Balay #define __FUNCT__ "PetscSetFPTrap"
288e5c89e4eSSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap on)
289e5c89e4eSSatish Balay {
290e5c89e4eSSatish Balay   PetscFunctionBegin;
291e5c89e4eSSatish Balay   if (on == PETSC_FP_TRAP_ON) {
292e5c89e4eSSatish Balay     signal(SIGFPE,(void (*)(int))PetscDefaultFPTrap);
293e5c89e4eSSatish Balay     fp_trap(FP_TRAP_SYNC);
294e5c89e4eSSatish Balay     fp_enable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW);
295e5c89e4eSSatish Balay     /* fp_enable(mask) for individual traps.  Values are:
296e5c89e4eSSatish Balay        TRP_INVALID
297e5c89e4eSSatish Balay        TRP_DIV_BY_ZERO
298e5c89e4eSSatish Balay        TRP_OVERFLOW
299e5c89e4eSSatish Balay        TRP_UNDERFLOW
300e5c89e4eSSatish Balay        TRP_INEXACT
301e5c89e4eSSatish Balay        Can OR then together.
302e5c89e4eSSatish Balay        fp_enable_all(); for all traps.
303e5c89e4eSSatish Balay     */
304e5c89e4eSSatish Balay   } else {
305e5c89e4eSSatish Balay     signal(SIGFPE,SIG_DFL);
306e5c89e4eSSatish Balay     fp_disable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW);
307e5c89e4eSSatish Balay     fp_trap(FP_TRAP_OFF);
308e5c89e4eSSatish Balay   }
309e5c89e4eSSatish Balay   PetscFunctionReturn(0);
310e5c89e4eSSatish Balay }
311e5c89e4eSSatish Balay 
312b014e56cSJed Brown #elif defined PETSC_HAVE_FENV_H
313b014e56cSJed Brown /*
314b014e56cSJed Brown    C99 style floating point environment.
315b014e56cSJed Brown 
316b014e56cSJed Brown    Note that C99 merely specifies how to save, restore, and clear the floating
317b014e56cSJed Brown    point environment as well as defining an enumeration of exception codes.  In
318b014e56cSJed Brown    particular, C99 does not specify how to make floating point exceptions raise
319b014e56cSJed Brown    a signal.  Glibc offers this capability through FE_NOMASK_ENV (or with finer
320b014e56cSJed Brown    granularity, feenableexcept()), xmmintrin.h offers _MM_SET_EXCEPTION_MASK().
321b014e56cSJed Brown */
322b014e56cSJed Brown #include <fenv.h>
323b014e56cSJed Brown typedef struct {int code; const char *name;} FPNode;
324b014e56cSJed Brown static const FPNode error_codes[] = {
325b014e56cSJed Brown     {FE_DIVBYZERO,"divide by zero"},
326b014e56cSJed Brown     {FE_INEXACT,  "inexact floating point result"},
327b014e56cSJed Brown     {FE_INVALID,  "invalid floating point arguments (domain error)"},
328b014e56cSJed Brown     {FE_OVERFLOW, "floating point overflow"},
329b014e56cSJed Brown     {FE_UNDERFLOW,"floating point underflow"},
330b014e56cSJed Brown     {0           ,"unknown error"}
331b014e56cSJed Brown };
332b014e56cSJed Brown EXTERN_C_BEGIN
333b014e56cSJed Brown #undef __FUNCT__
334b014e56cSJed Brown #define __FUNCT__ "PetscDefaultFPTrap"
335b014e56cSJed Brown void PetscDefaultFPTrap(int sig)
336b014e56cSJed Brown {
337b014e56cSJed Brown   const FPNode *node;
338b014e56cSJed Brown   int          code;
339b014e56cSJed Brown   PetscTruth   matched = PETSC_FALSE;
340b014e56cSJed Brown 
341b014e56cSJed Brown   PetscFunctionBegin;
342b014e56cSJed Brown   /* Note: While it is possible for the exception state to be preserved by the
343b014e56cSJed Brown    * kernel, this seems to be rare which makes the following flag testing almost
344b014e56cSJed Brown    * useless.  But on a system where the flags can be preserved, it would provide
3457d125cddSJed Brown    * more detail.
346b014e56cSJed Brown    */
347b014e56cSJed Brown   code = fetestexcept(FE_ALL_EXCEPT);
348b014e56cSJed Brown   for (node=&error_codes[0]; node->code; node++) {
349b014e56cSJed Brown     if (code & node->code) {
350b014e56cSJed Brown       matched = PETSC_TRUE;
351b014e56cSJed Brown       (*PetscErrorPrintf)("*** floating point error \"%s\" occurred ***\n",node->name);
352b014e56cSJed Brown       code &= ~node->code; /* Unset this flag since it has been processed */
353b014e56cSJed Brown     }
354b014e56cSJed Brown   }
355b014e56cSJed Brown   if (!matched || code) { /* If any remaining flags are set, or we didn't process any flags */
356b014e56cSJed Brown     (*PetscErrorPrintf)("*** unknown floating point error occurred ***\n");
3577d125cddSJed Brown     (*PetscErrorPrintf)("The specific exception can be determined by running in a debugger.  When the\n");
3587d125cddSJed Brown     (*PetscErrorPrintf)("debugger traps the signal, the exception can be found with fetestexcept(0x%x)\n",FE_ALL_EXCEPT);
3597d125cddSJed Brown     (*PetscErrorPrintf)("where the result is a bitwise OR of the following flags:\n");
3607d125cddSJed 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);
361b014e56cSJed Brown   }
3627d125cddSJed Brown 
3637d125cddSJed Brown   (*PetscErrorPrintf)("Try option -start_in_debugger\n");
3647d125cddSJed Brown #if defined(PETSC_USE_DEBUG)
3657d125cddSJed Brown   if (!PetscStackActive) {
3667d125cddSJed Brown     (*PetscErrorPrintf)("  or try option -log_stack\n");
3677d125cddSJed Brown   } else {
3687d125cddSJed Brown     (*PetscErrorPrintf)("likely location of problem given in stack below\n");
3697d125cddSJed Brown     (*PetscErrorPrintf)("---------------------  Stack Frames ------------------------------------\n");
3707d125cddSJed Brown     PetscStackView(PETSC_VIEWER_STDOUT_SELF);
3717d125cddSJed Brown   }
3727d125cddSJed Brown #endif
3737d125cddSJed Brown #if !defined(PETSC_USE_DEBUG)
3747d125cddSJed Brown   (*PetscErrorPrintf)("configure using --with-debugging=yes, recompile, link, and run \n");
3757d125cddSJed Brown   (*PetscErrorPrintf)("with -start_in_debugger to get more information on the crash.\n");
3767d125cddSJed Brown #endif
377e32f2f54SBarry Smith   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"trapped floating point error");
378b014e56cSJed Brown   MPI_Abort(PETSC_COMM_WORLD,0);
379b014e56cSJed Brown }
380b014e56cSJed Brown EXTERN_C_END
381b014e56cSJed Brown 
382b014e56cSJed Brown #undef __FUNCT__
383b014e56cSJed Brown #define __FUNCT__ "PetscSetFPTrap"
384b014e56cSJed Brown PetscErrorCode PETSC_DLLEXPORT PetscSetFPTrap(PetscFPTrap on)
385b014e56cSJed Brown {
386b014e56cSJed Brown   PetscFunctionBegin;
387b014e56cSJed Brown   if (on == PETSC_FP_TRAP_ON) {
388b014e56cSJed Brown     /* Clear any flags that are currently set so that activating trapping will not immediately call the signal handler. */
389e32f2f54SBarry Smith     if (feclearexcept(FE_ALL_EXCEPT)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Cannot clear floating point exception flags\n");
390b014e56cSJed Brown #if defined FE_NOMASK_ENV
391b014e56cSJed Brown     /* We could use fesetenv(FE_NOMASK_ENV), but that causes spurious exceptions (like gettimeofday() -> PetscLogDouble). */
392e32f2f54SBarry 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");
393b014e56cSJed Brown #elif defined PETSC_HAVE_XMMINTRIN_H
394b014e56cSJed Brown     _MM_SET_EXCEPTION_MASK(_MM_MASK_INEXACT);
395b014e56cSJed Brown #else
396b014e56cSJed Brown     /* C99 does not provide a way to modify the environment so there is no portable way to activate trapping. */
397b014e56cSJed Brown #endif
398e32f2f54SBarry Smith     if (SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't set floating point handler\n");
399b014e56cSJed Brown   } else {
400e32f2f54SBarry Smith     if (fesetenv(FE_DFL_ENV)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Cannot disable floating point exceptions");
401e32f2f54SBarry Smith     if (SIG_ERR == signal(SIGFPE,SIG_DFL)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't clear floating point handler\n");
402b014e56cSJed Brown   }
403b014e56cSJed Brown   PetscFunctionReturn(0);
404b014e56cSJed Brown }
405b014e56cSJed Brown 
406e5c89e4eSSatish Balay /* -------------------------Default -----------------------------------*/
407e5c89e4eSSatish Balay #else
408e5c89e4eSSatish Balay EXTERN_C_BEGIN
409e5c89e4eSSatish Balay #undef __FUNCT__
410e5c89e4eSSatish Balay #define __FUNCT__ "PetscDefaultFPTrap"
411e5c89e4eSSatish Balay void PetscDefaultFPTrap(int sig)
412e5c89e4eSSatish Balay {
413e5c89e4eSSatish Balay   PetscFunctionBegin;
414e5c89e4eSSatish Balay   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
415e32f2f54SBarry Smith   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
416e5c89e4eSSatish Balay   MPI_Abort(PETSC_COMM_WORLD,0);
417e5c89e4eSSatish Balay }
418e5c89e4eSSatish Balay EXTERN_C_END
419e5c89e4eSSatish Balay #undef __FUNCT__
420e5c89e4eSSatish Balay #define __FUNCT__ "PetscSetFPTrap"
421e5c89e4eSSatish Balay PetscErrorCode PETSC_DLLEXPORT PetscSetFPTrap(PetscFPTrap on)
422e5c89e4eSSatish Balay {
423e5c89e4eSSatish Balay   PetscFunctionBegin;
424e5c89e4eSSatish Balay   if (on == PETSC_FP_TRAP_ON) {
425e5c89e4eSSatish Balay     if (SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap)) {
426e5c89e4eSSatish Balay       (*PetscErrorPrintf)("Can't set floatingpoint handler\n");
427e5c89e4eSSatish Balay     }
428e5c89e4eSSatish Balay   } else {
429e5c89e4eSSatish Balay     if (SIG_ERR == signal(SIGFPE,SIG_DFL)) {
430e5c89e4eSSatish Balay       (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
431e5c89e4eSSatish Balay     }
432e5c89e4eSSatish Balay   }
433e5c89e4eSSatish Balay   PetscFunctionReturn(0);
434e5c89e4eSSatish Balay }
435e5c89e4eSSatish Balay #endif
436e5c89e4eSSatish Balay 
437e5c89e4eSSatish Balay 
438e5c89e4eSSatish Balay 
439