xref: /petsc/src/sys/error/fp.c (revision c1730cc1cd3b6fc6205d70c430a9ca69e7268eec)
1 
2 /*
3    IEEE error handler for all machines. Since each OS has
4    enough slight differences we have completely separate codes for each one.
5 */
6 
7 /*
8   This feature test macro provides FE_NOMASK_ENV on GNU.  It must be defined
9   at the top of the file because other headers may pull in fenv.h even when
10   not strictly necessary.  Strictly speaking, we could include ONLY petscconf.h,
11   check PETSC_HAVE_FENV_H, and only define _GNU_SOURCE in that case, but such
12   shenanigans ought to be unnecessary.
13 */
14 #if !defined(_GNU_SOURCE)
15   #define _GNU_SOURCE
16 #endif
17 
18 #include <petsc/private/petscimpl.h> /*I  "petscsys.h"  I*/
19 #include <signal.h>
20 
21 struct PetscFPTrapLink {
22   PetscFPTrap             trapmode;
23   struct PetscFPTrapLink *next;
24 };
25 static PetscFPTrap             _trapmode = PETSC_FP_TRAP_OFF; /* Current trapping mode; see PetscDetermineInitialFPTrap() */
26 static struct PetscFPTrapLink *_trapstack;                    /* Any pushed states of _trapmode */
27 
28 /*@
29    PetscFPTrapPush - push a floating point trapping mode, restored using `PetscFPTrapPop()`
30 
31    Not Collective
32 
33    Input Parameter:
34 .    trap - `PETSC_FP_TRAP_ON` or `PETSC_FP_TRAP_OFF` or any of the values passable to `PetscSetFPTrap()`
35 
36    Level: advanced
37 
38    Notes:
39      This only changes the trapping if the new mode is different than the current mode.
40 
41      This routine is called to turn off trapping for certain LAPACK routines that assume that dividing
42      by zero is acceptable. In particular the routine ieeeck().
43 
44      Most systems by default have all trapping turned off, but certain Fortran compilers have
45      link flags that turn on trapping before the program begins.
46 $       gfortran -ffpe-trap=invalid,zero,overflow,underflow,denormal
47 $       ifort -fpe0
48 
49 .seealso: `PetscFPTrapPop()`, `PetscSetFPTrap()`, `PetscDetermineInitialFPTrap()`
50 @*/
51 PetscErrorCode PetscFPTrapPush(PetscFPTrap trap)
52 {
53   struct PetscFPTrapLink *link;
54 
55   PetscFunctionBegin;
56   PetscCall(PetscNew(&link));
57 #if defined(PETSC_HAVE_THREADSAFETY) && defined(PETSC_HAVE_OPENMP)
58   #pragma omp critical
59 #endif
60   {
61     link->trapmode = _trapmode;
62     link->next     = _trapstack;
63     _trapstack     = link;
64   }
65   if (trap != _trapmode) PetscCall(PetscSetFPTrap(trap));
66   PetscFunctionReturn(0);
67 }
68 
69 /*@
70    PetscFPTrapPop - push a floating point trapping mode, to be restored using `PetscFPTrapPop()`
71 
72    Not Collective
73 
74    Level: advanced
75 
76 .seealso: `PetscFPTrapPush()`, `PetscSetFPTrap()`, `PetscDetermineInitialFPTrap()`
77 @*/
78 PetscErrorCode PetscFPTrapPop(void)
79 {
80   struct PetscFPTrapLink *link;
81 
82   PetscFunctionBegin;
83   if (_trapstack->trapmode != _trapmode) PetscCall(PetscSetFPTrap(_trapstack->trapmode));
84 #if defined(PETSC_HAVE_THREADSAFETY) && defined(PETSC_HAVE_OPENMP)
85   #pragma omp critical
86 #endif
87   {
88     link       = _trapstack;
89     _trapstack = _trapstack->next;
90   }
91   PetscCall(PetscFree(link));
92   PetscFunctionReturn(0);
93 }
94 
95 /*--------------------------------------- ---------------------------------------------------*/
96 #if defined(PETSC_HAVE_SUN4_STYLE_FPTRAP)
97   #include <floatingpoint.h>
98 
99 PETSC_EXTERN PetscErrorCode ieee_flags(char *, char *, char *, char **);
100 PETSC_EXTERN PetscErrorCode ieee_handler(char *, char *, sigfpe_handler_type(int, int, struct sigcontext *, char *));
101 
102 static struct {
103   int   code_no;
104   char *name;
105 } error_codes[] = {
106   {FPE_INTDIV_TRAP,   "integer divide"               },
107   {FPE_FLTOPERR_TRAP, "IEEE operand error"           },
108   {FPE_FLTOVF_TRAP,   "floating point overflow"      },
109   {FPE_FLTUND_TRAP,   "floating point underflow"     },
110   {FPE_FLTDIV_TRAP,   "floating pointing divide"     },
111   {FPE_FLTINEX_TRAP,  "inexact floating point result"},
112   {0,                 "unknown error"                }
113 };
114   #define SIGPC(scp) (scp->sc_pc)
115 
116 /* this function gets called if a trap has occurred and been caught */
117 sigfpe_handler_type PetscDefaultFPTrap(int sig, int code, struct sigcontext *scp, char *addr)
118 {
119   int err_ind = -1;
120 
121   PetscFunctionBegin;
122   for (int j = 0; error_codes[j].code_no; j++) {
123     if (error_codes[j].code_no == code) err_ind = j;
124   }
125 
126   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n", error_codes[err_ind].name, SIGPC(scp));
127   else (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n", code, SIGPC(scp));
128 
129   (void)PetscError(PETSC_COMM_SELF, PETSC_ERR_FP, NULL, NULL, PETSC_ERR_FP, PETSC_ERROR_REPEAT, "floating point error");
130   PETSCABORT(MPI_COMM_WORLD, PETSC_ERR_FP);
131   PetscFunctionReturn(0);
132 }
133 
134 /*@
135    PetscSetFPTrap - Enables traps/exceptions on common floating point errors. This option may not work on certain systems or only a
136    subset of exceptions may be trapable.
137 
138    Not Collective
139 
140    Input Parameters:
141 .  flag - values are
142 .vb
143     PETSC_FP_TRAP_OFF   - do not trap any exceptions
144     PETSC_FP_TRAP_ON - all exceptions that are possible on the system except underflow
145     PETSC_FP_TRAP_INDIV - integer divide by zero
146     PETSC_FP_TRAP_FLTOPERR - improper argument to function, for example with real numbers, the square root of a negative number
147     PETSC_FP_TRAP_FLTOVF - overflow
148     PETSC_FP_TRAP_FLTUND - underflow - not trapped by default on most systems
149     PETSC_FP_TRAP_FLTDIV - floating point divide by zero
150     PETSC_FP_TRAP_FLTINEX - inexact floating point result
151 .ve
152 
153    Options Database Keys:
154 .  -fp_trap <off,on> - turn on or off trapping of floating point exceptions
155 
156    Level: advanced
157 
158    Notes:
159    Currently only `PETSC_FP_TRAP_OFF` and `PETSC_FP_TRAP_ON` are handled. All others are treated as `PETSC_FP_TRAP_ON`.
160 
161    The values are bit values and may be |ed together in the function call
162 
163    On systems that support it this routine causes floating point
164    overflow, divide-by-zero, and invalid-operand (e.g., a NaN), but not underflow, to
165    cause a message to be printed and the program to exit.
166 
167    On many common systems, the floating
168    point exception state is not preserved from the location where the trap
169    occurred through to the signal handler.  In this case, the signal handler
170    will just say that an unknown floating point exception occurred and which
171    function it occurred in.  If you run with -fp_trap in a debugger, it will
172    break on the line where the error occurred.  On systems that support C99
173    floating point exception handling You can check which
174    exception occurred using fetestexcept(FE_ALL_EXCEPT).  See fenv.h
175    (usually at /usr/include/bits/fenv.h) for the enum values on your system.
176 
177 .seealso: `PetscFPTrapPush()`, `PetscFPTrapPop()`, `PetscDetermineInitialFPTrap()`
178 @*/
179 PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
180 {
181   char *out;
182 
183   PetscFunctionBegin;
184   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
185   (void)ieee_flags("clear", "exception", "all", &out);
186   if (flag == PETSC_FP_TRAP_ON) {
187     /*
188       To trap more fp exceptions, including underflow, change the line below to
189       if (ieee_handler("set","all",PetscDefaultFPTrap)) {
190     */
191     if (ieee_handler("set", "common", PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't set floatingpoint handler\n");
192   } else if (ieee_handler("clear", "common", PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
193 
194   _trapmode = flag;
195   PetscCall(PetscInfo(NULL, "Using PETSC_HAVE_SUN4_STYLE_FPTRAP\n"));
196   PetscFunctionReturn(0);
197 }
198 
199 /*@
200    PetscDetermineInitialFPTrap - Attempts to determine the floating point trapping that exists when `PetscInitialize()` is called
201 
202    Not Collective
203 
204    Note:
205       Currently only supported on Linux and MacOS. Checks if divide by zero is enable and if so declares that trapping is on.
206 
207    Level: advanced
208 
209 .seealso: `PetscFPTrapPush()`, `PetscFPTrapPop()`, `PetscDetermineInitialFPTrap()`
210 @*/
211 PetscErrorCode PetscDetermineInitialFPTrap(void)
212 {
213   PetscFunctionBegin;
214   PetscCall(PetscInfo(NULL, "Unable to determine initial floating point trapping. Assuming it is off\n"));
215   PetscFunctionReturn(0);
216 }
217 
218 /* -------------------------------------------------------------------------------------------*/
219 #elif defined(PETSC_HAVE_SOLARIS_STYLE_FPTRAP)
220   #include <sunmath.h>
221   #include <floatingpoint.h>
222   #include <siginfo.h>
223   #include <ucontext.h>
224 
225 static struct {
226   int   code_no;
227   char *name;
228 } error_codes[] = {
229   {FPE_FLTINV, "invalid floating point operand"},
230   {FPE_FLTRES, "inexact floating point result" },
231   {FPE_FLTDIV, "division-by-zero"              },
232   {FPE_FLTUND, "floating point underflow"      },
233   {FPE_FLTOVF, "floating point overflow"       },
234   {0,          "unknown error"                 }
235 };
236   #define SIGPC(scp) (scp->si_addr)
237 
238 void PetscDefaultFPTrap(int sig, siginfo_t *scp, ucontext_t *uap)
239 {
240   int err_ind = -1, code = scp->si_code;
241 
242   PetscFunctionBegin;
243   for (int j = 0; error_codes[j].code_no; j++) {
244     if (error_codes[j].code_no == code) err_ind = j;
245   }
246 
247   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n", error_codes[err_ind].name, SIGPC(scp));
248   else (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n", code, SIGPC(scp));
249 
250   (void)PetscError(PETSC_COMM_SELF, 0, NULL, NULL, PETSC_ERR_FP, PETSC_ERROR_REPEAT, "floating point error");
251   PETSCABORT(MPI_COMM_WORLD, PETSC_ERR_FP);
252 }
253 
254 PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
255 {
256   char *out;
257 
258   PetscFunctionBegin;
259   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
260   (void)ieee_flags("clear", "exception", "all", &out);
261   if (flag == PETSC_FP_TRAP_ON) {
262     if (ieee_handler("set", "common", (sigfpe_handler_type)PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't set floating point handler\n");
263   } else {
264     if (ieee_handler("clear", "common", (sigfpe_handler_type)PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
265   }
266   _trapmode = flag;
267   PetscCall(PetscInfo(NULL,"Using PETSC_HAVE_SOLARIS_STYLE_FPTRAP\n");
268   PetscFunctionReturn(0);
269 }
270 
271 PetscErrorCode PetscDetermineInitialFPTrap(void)
272 {
273   PetscFunctionBegin;
274   PetscCall(PetscInfo(NULL, "Unable to determine initial floating point trapping. Assuming it is off\n"));
275   PetscFunctionReturn(0);
276 }
277 
278 /* ------------------------------------------------------------------------------------------*/
279 #elif defined(PETSC_HAVE_IRIX_STYLE_FPTRAP)
280   #include <sigfpe.h>
281 static struct {
282   int   code_no;
283   char *name;
284 } error_codes[] = {
285   {_INVALID, "IEEE operand error"      },
286   {_OVERFL,  "floating point overflow" },
287   {_UNDERFL, "floating point underflow"},
288   {_DIVZERO, "floating point divide"   },
289   {0,        "unknown error"           }
290 };
291 void PetscDefaultFPTrap(unsigned exception[], int val[])
292 {
293   int err_ind = -1, code = exception[0];
294 
295   PetscFunctionBegin;
296   for (int j = 0; error_codes[j].code_no; j++) {
297     if (error_codes[j].code_no == code) err_ind = j;
298   }
299   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred ***\n", error_codes[err_ind].name);
300   else (*PetscErrorPrintf)("*** floating point error 0x%x occurred ***\n", code);
301 
302   (void)PetscError(PETSC_COMM_SELF, 0, NULL, NULL, PETSC_ERR_FP, PETSC_ERROR_REPEAT, "floating point error");
303   PETSCABORT(MPI_COMM_WORLD, PETSC_ERR_FP);
304 }
305 
306 PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
307 {
308   PetscFunctionBegin;
309   if (flag == PETSC_FP_TRAP_ON) handle_sigfpes(_ON, , _EN_UNDERFL | _EN_OVERFL | _EN_DIVZERO | _EN_INVALID, PetscDefaultFPTrap, _ABORT_ON_ERROR, 0);
310   else handle_sigfpes(_OFF, _EN_UNDERFL | _EN_OVERFL | _EN_DIVZERO | _EN_INVALID, 0, _ABORT_ON_ERROR, 0);
311   _trapmode = flag;
312   PetscCall(PetscInfo(NULL, "Using PETSC_HAVE_IRIX_STYLE_FPTRAP\n"));
313   PetscFunctionReturn(0);
314 }
315 
316 PetscErrorCode PetscDetermineInitialFPTrap(void)
317 {
318   PetscFunctionBegin;
319   PetscCall(PetscInfo(NULL, "Unable to determine initial floating point trapping. Assuming it is off\n"));
320   PetscFunctionReturn(0);
321 }
322 
323 /*----------------------------------------------- --------------------------------------------*/
324 #elif defined(PETSC_HAVE_RS6000_STYLE_FPTRAP)
325 /* In "fast" mode, floating point traps are imprecise and ignored.
326    This is the reason for the fptrap(FP_TRAP_SYNC) call */
327 struct sigcontext;
328   #include <fpxcp.h>
329   #include <fptrap.h>
330   #define FPE_FLTOPERR_TRAP (fptrap_t)(0x20000000)
331   #define FPE_FLTOVF_TRAP   (fptrap_t)(0x10000000)
332   #define FPE_FLTUND_TRAP   (fptrap_t)(0x08000000)
333   #define FPE_FLTDIV_TRAP   (fptrap_t)(0x04000000)
334   #define FPE_FLTINEX_TRAP  (fptrap_t)(0x02000000)
335 
336 static struct {
337   int   code_no;
338   char *name;
339 } error_codes[] = {
340   {FPE_FLTOPERR_TRAP, "IEEE operand error"           },
341   {FPE_FLTOVF_TRAP,   "floating point overflow"      },
342   {FPE_FLTUND_TRAP,   "floating point underflow"     },
343   {FPE_FLTDIV_TRAP,   "floating point divide"        },
344   {FPE_FLTINEX_TRAP,  "inexact floating point result"},
345   < {0,                 "unknown error"                }
346 };
347   #define SIGPC(scp)        (0) /* Info MIGHT be in scp->sc_jmpbuf.jmp_context.iar */
348 /*
349    For some reason, scp->sc_jmpbuf does not work on the RS6000, even though
350    it looks like it should from the include definitions.  It is probably
351    some strange interaction with the "POSIX_SOURCE" that we require.
352 */
353 
354 void PetscDefaultFPTrap(int sig, int code, struct sigcontext *scp)
355 {
356   int      err_ind, j;
357   fp_ctx_t flt_context;
358 
359   PetscFunctionBegin;
360   fp_sh_trap_info(scp, &flt_context);
361 
362   err_ind = -1;
363   for (j = 0; error_codes[j].code_no; j++) {
364     if (error_codes[j].code_no == flt_context.trap) err_ind = j;
365   }
366 
367   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred ***\n", error_codes[err_ind].name);
368   else (*PetscErrorPrintf)("*** floating point error 0x%x occurred ***\n", flt_context.trap);
369 
370   (void)PetscError(PETSC_COMM_SELF, 0, NULL, NULL, PETSC_ERR_FP, PETSC_ERROR_REPEAT, "floating point error");
371   PETSCABORT(MPI_COMM_WORLD, PETSC_ERR_FP);
372 }
373 
374 PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
375 {
376   PetscFunctionBegin;
377   if (flag == PETSC_FP_TRAP_ON) {
378     signal(SIGFPE, (void (*)(int))PetscDefaultFPTrap);
379     fp_trap(FP_TRAP_SYNC);
380     /* fp_enable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW | TRP_UNDERFLOW); */
381     fp_enable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW);
382   } else {
383     signal(SIGFPE, SIG_DFL);
384     fp_disable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW | TRP_UNDERFLOW);
385     fp_trap(FP_TRAP_OFF);
386   }
387   _trapmode = flag;
388   PetscCall(PetscInfo(NULL, "Using PETSC_HAVE_RS6000_STYLE_FPTRAP\n"));
389   PetscFunctionReturn(0);
390 }
391 
392 PetscErrorCode PetscDetermineInitialFPTrap(void)
393 {
394   PetscFunctionBegin;
395   PetscCall(PetscInfo(NULL, "Unable to determine initial floating point trapping. Assuming it is off\n"));
396   PetscFunctionReturn(0);
397 }
398 
399 /* ------------------------------------------------------------*/
400 #elif defined(PETSC_HAVE_WINDOWS_COMPILERS)
401   #include <float.h>
402 void PetscDefaultFPTrap(int sig)
403 {
404   PetscFunctionBegin;
405   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
406   PetscError(PETSC_COMM_SELF, 0, NULL, NULL, PETSC_ERR_FP, PETSC_ERROR_REPEAT, "floating point error");
407   PETSCABORT(MPI_COMM_WORLD, PETSC_ERR_FP);
408 }
409 
410 PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
411 {
412   unsigned int cw;
413 
414   PetscFunctionBegin;
415   if (flag == PETSC_FP_TRAP_ON) {
416     /* cw = _EM_INVALID | _EM_ZERODIVIDE | _EM_OVERFLOW | _EM_UNDERFLOW; */
417     cw = _EM_INVALID | _EM_ZERODIVIDE | _EM_OVERFLOW;
418     PetscCheck(SIG_ERR != signal(SIGFPE, PetscDefaultFPTrap), PETSC_COMM_SELF, PETSC_ERR_LIB, "Can't set floating point handler");
419   } else {
420     cw = 0;
421     PetscCheck(SIG_ERR != signal(SIGFPE, SIG_DFL), PETSC_COMM_SELF, PETSC_ERR_LIB, "Can't clear floating point handler");
422   }
423   (void)_controlfp(0, cw);
424   _trapmode = flag;
425   PetscCall(PetscInfo(NULL, "Using PETSC_HAVE_WINDOWS_COMPILERS FPTRAP\n"));
426   PetscFunctionReturn(0);
427 }
428 
429 PetscErrorCode PetscDetermineInitialFPTrap(void)
430 {
431   PetscFunctionBegin;
432   PetscCall(PetscInfo(NULL, "Unable to determine initial floating point trapping. Assuming it is off\n"));
433   PetscFunctionReturn(0);
434 }
435 
436 /* ------------------------------------------------------------*/
437 #elif defined(PETSC_HAVE_FENV_H) && !defined(__cplusplus)
438   /*
439    C99 style floating point environment.
440 
441    Note that C99 merely specifies how to save, restore, and clear the floating
442    point environment as well as defining an enumeration of exception codes.  In
443    particular, C99 does not specify how to make floating point exceptions raise
444    a signal.  Glibc offers this capability through FE_NOMASK_ENV (or with finer
445    granularity, feenableexcept()), xmmintrin.h offers _MM_SET_EXCEPTION_MASK().
446 */
447   #include <fenv.h>
448   #if defined(PETSC_HAVE_FE_VALUES)
449 typedef struct {
450   int         code;
451   const char *name;
452 } FPNode;
453 static const FPNode error_codes[] = {
454   {FE_DIVBYZERO, "divide by zero"                                 },
455   {FE_INEXACT,   "inexact floating point result"                  },
456   {FE_INVALID,   "invalid floating point arguments (domain error)"},
457   {FE_OVERFLOW,  "floating point overflow"                        },
458   {FE_UNDERFLOW, "floating point underflow"                       },
459   {0,            "unknown error"                                  }
460 };
461   #endif
462 
463 void PetscDefaultFPTrap(int sig)
464 {
465   #if defined(PETSC_HAVE_FE_VALUES)
466   const FPNode *node;
467   int           code;
468   PetscBool     matched = PETSC_FALSE;
469   #endif
470 
471   PetscFunctionBegin;
472   /* Note: While it is possible for the exception state to be preserved by the
473    * kernel, this seems to be rare which makes the following flag testing almost
474    * useless.  But on a system where the flags can be preserved, it would provide
475    * more detail.
476    */
477   #if defined(PETSC_HAVE_FE_VALUES)
478   code = fetestexcept(FE_ALL_EXCEPT);
479   for (node = &error_codes[0]; node->code; node++) {
480     if (code & node->code) {
481       matched = PETSC_TRUE;
482       (*PetscErrorPrintf)("*** floating point error \"%s\" occurred ***\n", node->name);
483       code &= ~node->code; /* Unset this flag since it has been processed */
484     }
485   }
486   if (!matched || code) { /* If any remaining flags are set, or we didn't process any flags */
487     (*PetscErrorPrintf)("*** unknown floating point error occurred ***\n");
488     (*PetscErrorPrintf)("The specific exception can be determined by running in a debugger.  When the\n");
489     (*PetscErrorPrintf)("debugger traps the signal, the exception can be found with fetestexcept(0x%x)\n", FE_ALL_EXCEPT);
490     (*PetscErrorPrintf)("where the result is a bitwise OR of the following flags:\n");
491     (*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);
492   }
493   #else
494   (*PetscErrorPrintf)("*** unknown floating point error occurred ***\n");
495   #endif
496 
497   (*PetscErrorPrintf)("Try option -start_in_debugger\n");
498   #if PetscDefined(USE_DEBUG)
499   (*PetscErrorPrintf)("likely location of problem given in stack below\n");
500   (*PetscErrorPrintf)("---------------------  Stack Frames ------------------------------------\n");
501   PetscStackView(PETSC_STDOUT);
502   #else
503   (*PetscErrorPrintf)("configure using --with-debugging=yes, recompile, link, and run \n");
504   (*PetscErrorPrintf)("with -start_in_debugger to get more information on the crash.\n");
505   #endif
506   PetscError(PETSC_COMM_SELF, 0, NULL, NULL, PETSC_ERR_FP, PETSC_ERROR_INITIAL, "trapped floating point error");
507   PETSCABORT(MPI_COMM_WORLD, PETSC_ERR_FP);
508 }
509 
510 PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
511 {
512   PetscFunctionBegin;
513   if (flag == PETSC_FP_TRAP_ON) {
514     /* Clear any flags that are currently set so that activating trapping will not immediately call the signal handler. */
515     PetscCheck(!feclearexcept(FE_ALL_EXCEPT), PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot clear floating point exception flags");
516   #if defined(FE_NOMASK_ENV) && defined(PETSC_HAVE_FE_VALUES)
517     /* Could use fesetenv(FE_NOMASK_ENV), but that causes spurious exceptions (like gettimeofday() -> PetscLogDouble). */
518     /* PetscCheck(feenableexcept(FE_DIVBYZERO | FE_INVALID | FE_OVERFLOW | FE_UNDERFLOW) != -1,PETSC_COMM_SELF,PETSC_ERR_LIB,"Cannot activate floating point exceptions"); */
519     /* Doesn't work on AArch64 targets. There's a known hardware limitation. Need to detect hardware at configure time? */
520     PetscCheck(feenableexcept(FE_DIVBYZERO | FE_INVALID | FE_OVERFLOW) != -1, PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot activate floating point exceptions");
521     PetscCall(PetscInfo(NULL, "Using PETSC_HAVE_FENV_H FPTRAP with FE_NOMASK_ENV\n"));
522   #elif defined PETSC_HAVE_XMMINTRIN_H
523     _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_DIV_ZERO);
524     /* _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_UNDERFLOW); */
525     _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_OVERFLOW);
526     _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_INVALID);
527     PetscCall(PetscInfo(NULL, "Using PETSC_HAVE_FENV_H FPTRAP with PETSC_HAVE_XMMINTRIN_H\n"));
528   #else
529     /* C99 does not provide a way to modify the environment so there is no portable way to activate trapping. */
530     PetscCall(PetscInfo(NULL, "Using PETSC_HAVE_FENV_H FPTRAP\n"));
531   #endif
532     PetscCheck(SIG_ERR != signal(SIGFPE, PetscDefaultFPTrap), PETSC_COMM_SELF, PETSC_ERR_LIB, "Can't set floating point handler");
533   } else {
534     PetscCheck(!fesetenv(FE_DFL_ENV), PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot disable floating point exceptions");
535     /* can use _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() | _MM_MASK_UNDERFLOW); if PETSC_HAVE_XMMINTRIN_H exists */
536     PetscCheck(SIG_ERR != signal(SIGFPE, SIG_DFL), PETSC_COMM_SELF, PETSC_ERR_LIB, "Can't clear floating point handler");
537   }
538   _trapmode = flag;
539   PetscFunctionReturn(0);
540 }
541 
542 PetscErrorCode PetscDetermineInitialFPTrap(void)
543 {
544   #if defined(FE_NOMASK_ENV) || defined PETSC_HAVE_XMMINTRIN_H
545   unsigned int flags;
546   #endif
547 
548   PetscFunctionBegin;
549   #if defined(FE_NOMASK_ENV)
550   flags = fegetexcept();
551   if (flags & FE_DIVBYZERO) {
552   #elif defined PETSC_HAVE_XMMINTRIN_H
553   flags = _MM_GET_EXCEPTION_MASK();
554   if (!(flags & _MM_MASK_DIV_ZERO)) {
555   #else
556   PetscCall(PetscInfo(NULL, "Floating point trapping unknown, assuming off\n"));
557   PetscFunctionReturn(0);
558   #endif
559   #if defined(FE_NOMASK_ENV) || defined PETSC_HAVE_XMMINTRIN_H
560     _trapmode = PETSC_FP_TRAP_ON;
561     PetscCall(PetscInfo(NULL, "Floating point trapping is on by default %d\n", flags));
562   } else {
563     _trapmode = PETSC_FP_TRAP_OFF;
564     PetscCall(PetscInfo(NULL, "Floating point trapping is off by default %d\n", flags));
565   }
566   PetscFunctionReturn(0);
567   #endif
568 }
569 
570 /* ------------------------------------------------------------*/
571 #elif defined(PETSC_HAVE_IEEEFP_H)
572   #include <ieeefp.h>
573 void PetscDefaultFPTrap(int sig)
574 {
575   PetscFunctionBegin;
576   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
577   PetscError(PETSC_COMM_SELF, 0, NULL, NULL, PETSC_ERR_FP, PETSC_ERROR_REPEAT, "floating point error");
578   PETSCABORT(MPI_COMM_WORLD, PETSC_ERR_FP);
579 }
580 
581 PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
582 {
583   PetscFunctionBegin;
584   if (flag == PETSC_FP_TRAP_ON) {
585   #if defined(PETSC_HAVE_FPPRESETSTICKY)
586     fpresetsticky(fpgetsticky());
587   #elif defined(PETSC_HAVE_FPSETSTICKY)
588     fpsetsticky(fpgetsticky());
589   #endif
590     fpsetmask(FP_X_INV | FP_X_DZ | FP_X_OFL | FP_X_OFL);
591     PetscCheck(SIG_ERR != signal(SIGFPE, PetscDefaultFPTrap), PETSC_COMM_SELF, PETSC_ERR_LIB, "Can't set floating point handler");
592   } else {
593   #if defined(PETSC_HAVE_FPPRESETSTICKY)
594     fpresetsticky(fpgetsticky());
595   #elif defined(PETSC_HAVE_FPSETSTICKY)
596     fpsetsticky(fpgetsticky());
597   #endif
598     fpsetmask(0);
599     PetscCheck(SIG_ERR != signal(SIGFPE, SIG_DFL), PETSC_COMM_SELF, PETSC_ERR_LIB, "Can't clear floating point handler");
600   }
601   _trapmode = flag;
602   PetscCall(PetscInfo(NULL, "Using PETSC_HAVE_IEEEFP_H FPTRAP\n"));
603   PetscFunctionReturn(0);
604 }
605 
606 PetscErrorCode PetscDetermineInitialFPTrap(void)
607 {
608   PetscFunctionBegin;
609   PetscCall(PetscInfo(NULL, "Unable to determine initial floating point trapping. Assuming it is off\n"));
610   PetscFunctionReturn(0);
611 }
612 
613 /* -------------------------Default -----------------------------------*/
614 #else
615 
616 void PetscDefaultFPTrap(int sig)
617 {
618   PetscFunctionBegin;
619   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
620   PetscError(PETSC_COMM_SELF, 0, NULL, NULL, PETSC_ERR_FP, PETSC_ERROR_REPEAT, "floating point error");
621   PETSCABORT(MPI_COMM_WORLD, PETSC_ERR_FP);
622 }
623 
624 PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
625 {
626   PetscFunctionBegin;
627   if (flag == PETSC_FP_TRAP_ON) {
628     if (SIG_ERR == signal(SIGFPE, PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't set floatingpoint handler\n");
629   } else if (SIG_ERR == signal(SIGFPE, SIG_DFL)) (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
630 
631   _trapmode = flag;
632   PetscCall(PetscInfo(NULL, "Using default FPTRAP\n"));
633   PetscFunctionReturn(0);
634 }
635 
636 PetscErrorCode PetscDetermineInitialFPTrap(void)
637 {
638   PetscFunctionBegin;
639   PetscCall(PetscInfo(NULL, "Unable to determine initial floating point trapping. Assuming it is off\n"));
640   PetscFunctionReturn(0);
641 }
642 #endif
643