xref: /petsc/src/sys/error/fp.c (revision b014e56c362ad3d2d14ac49f236e0c94d797d791)
1 #define PETSC_DLL
2 /*
3 *	IEEE error handler for all machines. Since each machine has
4 *   enough slight differences we have completely separate codes for each one.
5 *
6 */
7 
8 /*
9   This feature test macro provides FE_NOMASK_ENV on GNU.  It must be defined
10   at the top of the file because other headers may pull in fenv.h even when
11   not strictly necessary.  Strictly speaking, we could include ONLY petscconf.h,
12   check PETSC_HAVE_FENV_H, and only define _GNU_SOURCE in that case, but such
13   shenanigans ought to be unnecessary.
14 */
15 #define _GNU_SOURCE
16 
17 #include "petscsys.h"           /*I  "petscsys.h"  I*/
18 #include <signal.h>
19 #if defined(PETSC_HAVE_STDLIB_H)
20 #include <stdlib.h>
21 #endif
22 
23 /*--------------------------------------- ---------------------------------------------------*/
24 #if defined(PETSC_HAVE_SUN4_STYLE_FPTRAP)
25 #include <floatingpoint.h>
26 
27 EXTERN_C_BEGIN
28 PetscErrorCode ieee_flags(char*,char*,char*,char**);
29 PetscErrorCode ieee_handler(char *,char *,sigfpe_handler_type(int,int,struct sigcontext*,char *));
30 EXTERN_C_END
31 
32 static struct { int code_no; char *name; } error_codes[] = {
33            { FPE_INTDIV_TRAP	,"integer divide" },
34 	   { FPE_FLTOPERR_TRAP	,"IEEE operand error" },
35 	   { FPE_FLTOVF_TRAP	,"floating point overflow" },
36 	   { FPE_FLTUND_TRAP	,"floating point underflow" },
37 	   { FPE_FLTDIV_TRAP	,"floating pointing divide" },
38 	   { FPE_FLTINEX_TRAP	,"inexact floating point result" },
39 	   { 0			,"unknown error" }
40 } ;
41 #define SIGPC(scp) (scp->sc_pc)
42 
43 #undef __FUNCT__
44 #define __FUNCT__ "PetscDefaultFPTrap"
45 sigfpe_handler_type PetscDefaultFPTrap(int sig,int code,struct sigcontext *scp,char *addr)
46 {
47   PetscErrorCode ierr;
48   int err_ind = -1,j;
49 
50   PetscFunctionBegin;
51   for (j = 0 ; error_codes[j].code_no ; j++) {
52     if (error_codes[j].code_no == code) err_ind = j;
53   }
54 
55   if (err_ind >= 0) {
56     (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n",error_codes[err_ind].name,SIGPC(scp));
57   } else {
58     (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n",code,SIGPC(scp));
59   }
60   ierr = PetscError(PETSC_ERR_FP,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
61   MPI_Abort(PETSC_COMM_WORLD,0);
62   PetscFunctionReturn(0);
63 }
64 
65 #undef __FUNCT__
66 #define __FUNCT__ "PetscSetFPTrap"
67 /*@
68    PetscSetFPTrap - Enables traps/exceptions on common floating point errors.
69                     This option may not work on certain machines.
70 
71    Not Collective
72 
73    Input Parameters:
74 .  flag - PETSC_FP_TRAP_ON, PETSC_FP_TRAP_OFF.
75 
76    Options Database Keys:
77 .  -fp_trap - Activates floating point trapping
78 
79    Level: advanced
80 
81    Description:
82    On systems that support it, this routine causes floating point
83    overflow, divide-by-zero, and invalid-operand (e.g., a NaN) to
84    cause a message to be printed and the program to exit.
85 
86    Caution:
87    On certain machines, in particular the IBM rs6000, floating point
88    trapping is VERY slow!
89 
90    Concepts: floating point exceptions^trapping
91    Concepts: divide by zero
92 
93 @*/
94 PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
95 {
96   char *out;
97 
98   PetscFunctionBegin;
99   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
100   (void) ieee_flags("clear","exception","all",&out);
101   if (flag == PETSC_FP_TRAP_ON) {
102     if (ieee_handler("set","common",PetscDefaultFPTrap)) {
103       /*
104         To trap more fp exceptions, including undrflow, change the above line to
105         if (ieee_handler("set","all",PetscDefaultFPTrap)) {
106       */
107       (*PetscErrorPrintf)("Can't set floatingpoint handler\n");
108     }
109   } else {
110     if (ieee_handler("clear","common",PetscDefaultFPTrap)) {
111       (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
112     }
113   }
114   PetscFunctionReturn(0);
115 }
116 
117 /* -------------------------------------------------------------------------------------------*/
118 #elif defined(PETSC_HAVE_SOLARIS_STYLE_FPTRAP)
119 #include <sunmath.h>
120 #include <floatingpoint.h>
121 #include <siginfo.h>
122 #include <ucontext.h>
123 
124 static struct { int code_no; char *name; } error_codes[] = {
125   {  FPE_FLTINV,"invalid floating point operand"},
126   {  FPE_FLTRES,"inexact floating point result"},
127   {  FPE_FLTDIV,"division-by-zero"},
128   {  FPE_FLTUND,"floating point underflow"},
129   {  FPE_FLTOVF,"floating point overflow"},
130   {  0,         "unknown error"}
131 };
132 #define SIGPC(scp) (scp->si_addr)
133 
134 #undef __FUNCT__
135 #define __FUNCT__ "PetscDefaultFPTrap"
136 void PetscDefaultFPTrap(int sig,siginfo_t *scp,ucontext_t *uap)
137 {
138   int err_ind,j,code = scp->si_code;
139   PetscErrorCode ierr;
140 
141   PetscFunctionBegin;
142   err_ind = -1 ;
143   for (j = 0 ; error_codes[j].code_no ; j++) {
144     if (error_codes[j].code_no == code) err_ind = j;
145   }
146 
147   if (err_ind >= 0) {
148     (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n",error_codes[err_ind].name,SIGPC(scp));
149   } else {
150     (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n",code,SIGPC(scp));
151   }
152   ierr = PetscError(0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
153   MPI_Abort(PETSC_COMM_WORLD,0);
154 }
155 
156 #undef __FUNCT__
157 #define __FUNCT__ "PetscSetFPTrap"
158 PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
159 {
160   char *out;
161 
162   PetscFunctionBegin;
163   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
164   (void) ieee_flags("clear","exception","all",&out);
165   if (flag == PETSC_FP_TRAP_ON) {
166     if (ieee_handler("set","common",(sigfpe_handler_type)PetscDefaultFPTrap)) {
167       (*PetscErrorPrintf)("Can't set floating point handler\n");
168     }
169   } else {
170     if (ieee_handler("clear","common",(sigfpe_handler_type)PetscDefaultFPTrap)) {
171      (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
172     }
173   }
174   PetscFunctionReturn(0);
175 }
176 
177 /* ------------------------------------------------------------------------------------------*/
178 
179 #elif defined (PETSC_HAVE_IRIX_STYLE_FPTRAP)
180 #include <sigfpe.h>
181 static struct { int code_no; char *name; } error_codes[] = {
182        { _INVALID   ,"IEEE operand error" },
183        { _OVERFL    ,"floating point overflow" },
184        { _UNDERFL   ,"floating point underflow" },
185        { _DIVZERO   ,"floating point divide" },
186        { 0          ,"unknown error" }
187 } ;
188 #undef __FUNCT__
189 #define __FUNCT__ "PetscDefaultFPTrap"
190 void PetscDefaultFPTrap(unsigned exception[],int val[])
191 {
192   int err_ind,j,code;
193 
194   PetscFunctionBegin;
195   code = exception[0];
196   err_ind = -1 ;
197   for (j = 0 ; error_codes[j].code_no ; j++){
198     if (error_codes[j].code_no == code) err_ind = j;
199   }
200   if (err_ind >= 0){
201     (*PetscErrorPrintf)("*** %s occurred ***\n",error_codes[err_ind].name);
202   } else{
203     (*PetscErrorPrintf)("*** floating point error 0x%x occurred ***\n",code);
204   }
205   PetscError(0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
206   MPI_Abort(PETSC_COMM_WORLD,0);
207 }
208 
209 #undef __FUNCT__
210 #define __FUNCT__ "PetscSetFPTrap"
211 PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
212 {
213   PetscFunctionBegin;
214   if (flag == PETSC_FP_TRAP_ON) {
215     handle_sigfpes(_ON,_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,PetscDefaultFPTrap,_ABORT_ON_ERROR,0);
216   } else {
217     handle_sigfpes(_OFF,_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,0,_ABORT_ON_ERROR,0);
218   }
219   PetscFunctionReturn(0);
220 }
221 /*----------------------------------------------- --------------------------------------------*/
222 /* In "fast" mode, floating point traps are imprecise and ignored.
223    This is the reason for the fptrap(FP_TRAP_SYNC) call */
224 #elif defined(PETSC_HAVE_RS6000_STYLE_FPTRAP)
225 struct sigcontext;
226 #include <fpxcp.h>
227 #include <fptrap.h>
228 #include <stdlib.h>
229 #define FPE_FLTOPERR_TRAP (fptrap_t)(0x20000000)
230 #define FPE_FLTOVF_TRAP   (fptrap_t)(0x10000000)
231 #define FPE_FLTUND_TRAP   (fptrap_t)(0x08000000)
232 #define FPE_FLTDIV_TRAP   (fptrap_t)(0x04000000)
233 #define FPE_FLTINEX_TRAP  (fptrap_t)(0x02000000)
234 
235 static struct { int code_no; char *name; } error_codes[] = {
236            {FPE_FLTOPERR_TRAP	,"IEEE operand error" },
237 	   { FPE_FLTOVF_TRAP	,"floating point overflow" },
238 	   { FPE_FLTUND_TRAP	,"floating point underflow" },
239 	   { FPE_FLTDIV_TRAP	,"floating point divide" },
240 	   { FPE_FLTINEX_TRAP	,"inexact floating point result" },
241 	   { 0			,"unknown error" }
242 } ;
243 #define SIGPC(scp) (0) /* Info MIGHT be in scp->sc_jmpbuf.jmp_context.iar */
244 /*
245    For some reason, scp->sc_jmpbuf does not work on the RS6000, even though
246    it looks like it should from the include definitions.  It is probably
247    some strange interaction with the "POSIX_SOURCE" that we require.
248 */
249 
250 #undef __FUNCT__
251 #define __FUNCT__ "PetscDefaultFPTrap"
252 void PetscDefaultFPTrap(int sig,int code,struct sigcontext *scp)
253 {
254   PetscErrorCode ierr;
255   int      err_ind,j;
256   fp_ctx_t flt_context;
257 
258   PetscFunctionBegin;
259   fp_sh_trap_info(scp,&flt_context);
260 
261   err_ind = -1 ;
262   for (j = 0 ; error_codes[j].code_no ; j++) {
263     if (error_codes[j].code_no == flt_context.trap) err_ind = j;
264   }
265 
266   if (err_ind >= 0){
267     (*PetscErrorPrintf)("*** %s occurred ***\n",error_codes[err_ind].name);
268   } else{
269     (*PetscErrorPrintf)("*** floating point error 0x%x occurred ***\n",flt_context.trap);
270   }
271   ierr = PetscError(0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
272   MPI_Abort(PETSC_COMM_WORLD,0);
273 }
274 
275 #undef __FUNCT__
276 #define __FUNCT__ "PetscSetFPTrap"
277 PetscErrorCode PetscSetFPTrap(PetscFPTrap on)
278 {
279   PetscFunctionBegin;
280   if (on == PETSC_FP_TRAP_ON) {
281     signal(SIGFPE,(void (*)(int))PetscDefaultFPTrap);
282     fp_trap(FP_TRAP_SYNC);
283     fp_enable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW);
284     /* fp_enable(mask) for individual traps.  Values are:
285        TRP_INVALID
286        TRP_DIV_BY_ZERO
287        TRP_OVERFLOW
288        TRP_UNDERFLOW
289        TRP_INEXACT
290        Can OR then together.
291        fp_enable_all(); for all traps.
292     */
293   } else {
294     signal(SIGFPE,SIG_DFL);
295     fp_disable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW);
296     fp_trap(FP_TRAP_OFF);
297   }
298   PetscFunctionReturn(0);
299 }
300 
301 #elif defined PETSC_HAVE_FENV_H
302 /*
303    C99 style floating point environment.
304 
305    Note that C99 merely specifies how to save, restore, and clear the floating
306    point environment as well as defining an enumeration of exception codes.  In
307    particular, C99 does not specify how to make floating point exceptions raise
308    a signal.  Glibc offers this capability through FE_NOMASK_ENV (or with finer
309    granularity, feenableexcept()), xmmintrin.h offers _MM_SET_EXCEPTION_MASK().
310 */
311 #include <fenv.h>
312 typedef struct {int code; const char *name;} FPNode;
313 static const FPNode error_codes[] = {
314     {FE_DIVBYZERO,"divide by zero"},
315     {FE_INEXACT,  "inexact floating point result"},
316     {FE_INVALID,  "invalid floating point arguments (domain error)"},
317     {FE_OVERFLOW, "floating point overflow"},
318     {FE_UNDERFLOW,"floating point underflow"},
319     {0           ,"unknown error"}
320 };
321 EXTERN_C_BEGIN
322 #undef __FUNCT__
323 #define __FUNCT__ "PetscDefaultFPTrap"
324 void PetscDefaultFPTrap(int sig)
325 {
326   const FPNode *node;
327   int          code;
328   PetscTruth   matched = PETSC_FALSE;
329 
330   PetscFunctionBegin;
331   /* Note: While it is possible for the exception state to be preserved by the
332    * kernel, this seems to be rare which makes the following flag testing almost
333    * useless.  But on a system where the flags can be preserved, it would provide
334    * more detail.  In practice, you will probably have to run in a debugger and check
335    * fetestexcept() by hand to determine exactly which exception was raised.
336    */
337   code = fetestexcept(FE_ALL_EXCEPT);
338   for (node=&error_codes[0]; node->code; node++) {
339     if (code & node->code) {
340       matched = PETSC_TRUE;
341       (*PetscErrorPrintf)("*** floating point error \"%s\" occurred ***\n",node->name);
342       code &= ~node->code; /* Unset this flag since it has been processed */
343     }
344   }
345   if (!matched || code) { /* If any remaining flags are set, or we didn't process any flags */
346     (*PetscErrorPrintf)("*** unknown floating point error occurred ***\n");
347   }
348   PetscError(0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
349   MPI_Abort(PETSC_COMM_WORLD,0);
350 }
351 EXTERN_C_END
352 
353 #undef __FUNCT__
354 #define __FUNCT__ "PetscSetFPTrap"
355 PetscErrorCode PETSC_DLLEXPORT PetscSetFPTrap(PetscFPTrap on)
356 {
357   PetscFunctionBegin;
358   if (on == PETSC_FP_TRAP_ON) {
359     /* Clear any flags that are currently set so that activating trapping will not immediately call the signal handler. */
360     if (feclearexcept(FE_ALL_EXCEPT)) SETERRQ(PETSC_ERR_LIB,"Cannot clear floating point exception flags\n");
361 #if defined FE_NOMASK_ENV
362     /* We could use fesetenv(FE_NOMASK_ENV), but that causes spurious exceptions (like gettimeofday() -> PetscLogDouble). */
363     if (feenableexcept(FE_DIVBYZERO | FE_INVALID | FE_OVERFLOW | FE_UNDERFLOW) == -1) SETERRQ(PETSC_ERR_LIB,"Cannot activate floating point exceptions\n");
364 #elif defined PETSC_HAVE_XMMINTRIN_H
365     _MM_SET_EXCEPTION_MASK(_MM_MASK_INEXACT);
366 #else
367     /* C99 does not provide a way to modify the environment so there is no portable way to activate trapping. */
368 #endif
369     if (SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap)) SETERRQ(PETSC_ERR_LIB,"Can't set floating point handler\n");
370   } else {
371     if (fesetenv(FE_DFL_ENV)) SETERRQ(PETSC_ERR_LIB,"Cannot disable floating point exceptions");
372     if (SIG_ERR == signal(SIGFPE,SIG_DFL)) SETERRQ(PETSC_ERR_LIB,"Can't clear floating point handler\n");
373   }
374   PetscFunctionReturn(0);
375 }
376 
377 /* -------------------------Default -----------------------------------*/
378 #else
379 EXTERN_C_BEGIN
380 #undef __FUNCT__
381 #define __FUNCT__ "PetscDefaultFPTrap"
382 void PetscDefaultFPTrap(int sig)
383 {
384   PetscFunctionBegin;
385   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
386   PetscError(0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
387   MPI_Abort(PETSC_COMM_WORLD,0);
388 }
389 EXTERN_C_END
390 #undef __FUNCT__
391 #define __FUNCT__ "PetscSetFPTrap"
392 PetscErrorCode PETSC_DLLEXPORT PetscSetFPTrap(PetscFPTrap on)
393 {
394   PetscFunctionBegin;
395   if (on == PETSC_FP_TRAP_ON) {
396     if (SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap)) {
397       (*PetscErrorPrintf)("Can't set floatingpoint handler\n");
398     }
399   } else {
400     if (SIG_ERR == signal(SIGFPE,SIG_DFL)) {
401       (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
402     }
403   }
404   PetscFunctionReturn(0);
405 }
406 #endif
407 
408 
409 
410