xref: /petsc/src/sys/error/fp.c (revision 0700a8246d308f50502909ba325e6169d3ee27eb)
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 #include "petscsys.h"           /*I  "petscsys.h"  I*/
8 #include <signal.h>
9 #if defined(PETSC_HAVE_STDLIB_H)
10 #include <stdlib.h>
11 #endif
12 
13 /*--------------------------------------- ---------------------------------------------------*/
14 #if defined(PETSC_HAVE_SUN4_STYLE_FPTRAP)
15 #include <floatingpoint.h>
16 
17 EXTERN_C_BEGIN
18 PetscErrorCode ieee_flags(char*,char*,char*,char**);
19 PetscErrorCode ieee_handler(char *,char *,sigfpe_handler_type(int,int,struct sigcontext*,char *));
20 EXTERN_C_END
21 
22 static struct { int code_no; char *name; } error_codes[] = {
23            { FPE_INTDIV_TRAP	,"integer divide" },
24 	   { FPE_FLTOPERR_TRAP	,"IEEE operand error" },
25 	   { FPE_FLTOVF_TRAP	,"floating point overflow" },
26 	   { FPE_FLTUND_TRAP	,"floating point underflow" },
27 	   { FPE_FLTDIV_TRAP	,"floating pointing divide" },
28 	   { FPE_FLTINEX_TRAP	,"inexact floating point result" },
29 	   { 0			,"unknown error" }
30 } ;
31 #define SIGPC(scp) (scp->sc_pc)
32 
33 #undef __FUNCT__
34 #define __FUNCT__ "PetscDefaultFPTrap"
35 sigfpe_handler_type PetscDefaultFPTrap(int sig,int code,struct sigcontext *scp,char *addr)
36 {
37   PetscErrorCode ierr;
38   int err_ind = -1,j;
39 
40   PetscFunctionBegin;
41   for (j = 0 ; error_codes[j].code_no ; j++) {
42     if (error_codes[j].code_no == code) err_ind = j;
43   }
44 
45   if (err_ind >= 0) {
46     (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n",error_codes[err_ind].name,SIGPC(scp));
47   } else {
48     (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n",code,SIGPC(scp));
49   }
50   ierr = PetscError(PETSC_ERR_FP,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
51   MPI_Abort(PETSC_COMM_WORLD,0);
52   PetscFunctionReturn(0);
53 }
54 
55 #undef __FUNCT__
56 #define __FUNCT__ "PetscSetFPTrap"
57 /*@
58    PetscSetFPTrap - Enables traps/exceptions on common floating point errors.
59                     This option may not work on certain machines.
60 
61    Not Collective
62 
63    Input Parameters:
64 .  flag - PETSC_FP_TRAP_ON, PETSC_FP_TRAP_OFF.
65 
66    Options Database Keys:
67 .  -fp_trap - Activates floating point trapping
68 
69    Level: advanced
70 
71    Description:
72    On systems that support it, this routine causes floating point
73    overflow, divide-by-zero, and invalid-operand (e.g., a NaN) to
74    cause a message to be printed and the program to exit.
75 
76    Caution:
77    On certain machines, in particular the IBM rs6000, floating point
78    trapping is VERY slow!
79 
80    Concepts: floating point exceptions^trapping
81    Concepts: divide by zero
82 
83 @*/
84 PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
85 {
86   char *out;
87 
88   PetscFunctionBegin;
89   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
90   (void) ieee_flags("clear","exception","all",&out);
91   if (flag == PETSC_FP_TRAP_ON) {
92     if (ieee_handler("set","common",PetscDefaultFPTrap)) {
93       /*
94         To trap more fp exceptions, including undrflow, change the above line to
95         if (ieee_handler("set","all",PetscDefaultFPTrap)) {
96       */
97       (*PetscErrorPrintf)("Can't set floatingpoint handler\n");
98     }
99   } else {
100     if (ieee_handler("clear","common",PetscDefaultFPTrap)) {
101       (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
102     }
103   }
104   PetscFunctionReturn(0);
105 }
106 
107 /* -------------------------------------------------------------------------------------------*/
108 #elif defined(PETSC_HAVE_SOLARIS_STYLE_FPTRAP)
109 #include <sunmath.h>
110 #include <floatingpoint.h>
111 #include <siginfo.h>
112 #include <ucontext.h>
113 
114 static struct { int code_no; char *name; } error_codes[] = {
115   {  FPE_FLTINV,"invalid floating point operand"},
116   {  FPE_FLTRES,"inexact floating point result"},
117   {  FPE_FLTDIV,"division-by-zero"},
118   {  FPE_FLTUND,"floating point underflow"},
119   {  FPE_FLTOVF,"floating point overflow"},
120   {  0,         "unknown error"}
121 };
122 #define SIGPC(scp) (scp->si_addr)
123 
124 #undef __FUNCT__
125 #define __FUNCT__ "PetscDefaultFPTrap"
126 void PetscDefaultFPTrap(int sig,siginfo_t *scp,ucontext_t *uap)
127 {
128   int err_ind,j,code = scp->si_code;
129   PetscErrorCode ierr;
130 
131   PetscFunctionBegin;
132   err_ind = -1 ;
133   for (j = 0 ; error_codes[j].code_no ; j++) {
134     if (error_codes[j].code_no == code) err_ind = j;
135   }
136 
137   if (err_ind >= 0) {
138     (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n",error_codes[err_ind].name,SIGPC(scp));
139   } else {
140     (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n",code,SIGPC(scp));
141   }
142   ierr = PetscError(0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
143   MPI_Abort(PETSC_COMM_WORLD,0);
144 }
145 
146 #undef __FUNCT__
147 #define __FUNCT__ "PetscSetFPTrap"
148 PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
149 {
150   char *out;
151 
152   PetscFunctionBegin;
153   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
154   (void) ieee_flags("clear","exception","all",&out);
155   if (flag == PETSC_FP_TRAP_ON) {
156     if (ieee_handler("set","common",(sigfpe_handler_type)PetscDefaultFPTrap)) {
157       (*PetscErrorPrintf)("Can't set floating point handler\n");
158     }
159   } else {
160     if (ieee_handler("clear","common",(sigfpe_handler_type)PetscDefaultFPTrap)) {
161      (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
162     }
163   }
164   PetscFunctionReturn(0);
165 }
166 
167 /* ------------------------------------------------------------------------------------------*/
168 
169 #elif defined (PETSC_HAVE_IRIX_STYLE_FPTRAP)
170 #include <sigfpe.h>
171 static struct { int code_no; char *name; } error_codes[] = {
172        { _INVALID   ,"IEEE operand error" },
173        { _OVERFL    ,"floating point overflow" },
174        { _UNDERFL   ,"floating point underflow" },
175        { _DIVZERO   ,"floating point divide" },
176        { 0          ,"unknown error" }
177 } ;
178 #undef __FUNCT__
179 #define __FUNCT__ "PetscDefaultFPTrap"
180 void PetscDefaultFPTrap(unsigned exception[],int val[])
181 {
182   int err_ind,j,code;
183 
184   PetscFunctionBegin;
185   code = exception[0];
186   err_ind = -1 ;
187   for (j = 0 ; error_codes[j].code_no ; j++){
188     if (error_codes[j].code_no == code) err_ind = j;
189   }
190   if (err_ind >= 0){
191     (*PetscErrorPrintf)("*** %s occurred ***\n",error_codes[err_ind].name);
192   } else{
193     (*PetscErrorPrintf)("*** floating point error 0x%x occurred ***\n",code);
194   }
195   PetscError(0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
196   MPI_Abort(PETSC_COMM_WORLD,0);
197 }
198 
199 #undef __FUNCT__
200 #define __FUNCT__ "PetscSetFPTrap"
201 PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
202 {
203   PetscFunctionBegin;
204   if (flag == PETSC_FP_TRAP_ON) {
205     handle_sigfpes(_ON,_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,PetscDefaultFPTrap,_ABORT_ON_ERROR,0);
206   } else {
207     handle_sigfpes(_OFF,_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,0,_ABORT_ON_ERROR,0);
208   }
209   PetscFunctionReturn(0);
210 }
211 /*----------------------------------------------- --------------------------------------------*/
212 /* In "fast" mode, floating point traps are imprecise and ignored.
213    This is the reason for the fptrap(FP_TRAP_SYNC) call */
214 #elif defined(PETSC_HAVE_RS6000_STYLE_FPTRAP)
215 struct sigcontext;
216 #include <fpxcp.h>
217 #include <fptrap.h>
218 #include <stdlib.h>
219 #define FPE_FLTOPERR_TRAP (fptrap_t)(0x20000000)
220 #define FPE_FLTOVF_TRAP   (fptrap_t)(0x10000000)
221 #define FPE_FLTUND_TRAP   (fptrap_t)(0x08000000)
222 #define FPE_FLTDIV_TRAP   (fptrap_t)(0x04000000)
223 #define FPE_FLTINEX_TRAP  (fptrap_t)(0x02000000)
224 
225 static struct { int code_no; char *name; } error_codes[] = {
226            {FPE_FLTOPERR_TRAP	,"IEEE operand error" },
227 	   { FPE_FLTOVF_TRAP	,"floating point overflow" },
228 	   { FPE_FLTUND_TRAP	,"floating point underflow" },
229 	   { FPE_FLTDIV_TRAP	,"floating point divide" },
230 	   { FPE_FLTINEX_TRAP	,"inexact floating point result" },
231 	   { 0			,"unknown error" }
232 } ;
233 #define SIGPC(scp) (0) /* Info MIGHT be in scp->sc_jmpbuf.jmp_context.iar */
234 /*
235    For some reason, scp->sc_jmpbuf does not work on the RS6000, even though
236    it looks like it should from the include definitions.  It is probably
237    some strange interaction with the "POSIX_SOURCE" that we require.
238 */
239 
240 #undef __FUNCT__
241 #define __FUNCT__ "PetscDefaultFPTrap"
242 void PetscDefaultFPTrap(int sig,int code,struct sigcontext *scp)
243 {
244   PetscErrorCode ierr;
245   int      err_ind,j;
246   fp_ctx_t flt_context;
247 
248   PetscFunctionBegin;
249   fp_sh_trap_info(scp,&flt_context);
250 
251   err_ind = -1 ;
252   for (j = 0 ; error_codes[j].code_no ; j++) {
253     if (error_codes[j].code_no == flt_context.trap) err_ind = j;
254   }
255 
256   if (err_ind >= 0){
257     (*PetscErrorPrintf)("*** %s occurred ***\n",error_codes[err_ind].name);
258   } else{
259     (*PetscErrorPrintf)("*** floating point error 0x%x occurred ***\n",flt_context.trap);
260   }
261   ierr = PetscError(0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
262   MPI_Abort(PETSC_COMM_WORLD,0);
263 }
264 
265 #undef __FUNCT__
266 #define __FUNCT__ "PetscSetFPTrap"
267 PetscErrorCode PetscSetFPTrap(PetscFPTrap on)
268 {
269   PetscFunctionBegin;
270   if (on == PETSC_FP_TRAP_ON) {
271     signal(SIGFPE,(void (*)(int))PetscDefaultFPTrap);
272     fp_trap(FP_TRAP_SYNC);
273     fp_enable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW);
274     /* fp_enable(mask) for individual traps.  Values are:
275        TRP_INVALID
276        TRP_DIV_BY_ZERO
277        TRP_OVERFLOW
278        TRP_UNDERFLOW
279        TRP_INEXACT
280        Can OR then together.
281        fp_enable_all(); for all traps.
282     */
283   } else {
284     signal(SIGFPE,SIG_DFL);
285     fp_disable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW);
286     fp_trap(FP_TRAP_OFF);
287   }
288   PetscFunctionReturn(0);
289 }
290 
291 /* -------------------------Default -----------------------------------*/
292 #else
293 EXTERN_C_BEGIN
294 #undef __FUNCT__
295 #define __FUNCT__ "PetscDefaultFPTrap"
296 void PetscDefaultFPTrap(int sig)
297 {
298   PetscFunctionBegin;
299   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
300   PetscError(0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
301   MPI_Abort(PETSC_COMM_WORLD,0);
302 }
303 EXTERN_C_END
304 #undef __FUNCT__
305 #define __FUNCT__ "PetscSetFPTrap"
306 PetscErrorCode PETSC_DLLEXPORT PetscSetFPTrap(PetscFPTrap on)
307 {
308   PetscFunctionBegin;
309   if (on == PETSC_FP_TRAP_ON) {
310     if (SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap)) {
311       (*PetscErrorPrintf)("Can't set floatingpoint handler\n");
312     }
313   } else {
314     if (SIG_ERR == signal(SIGFPE,SIG_DFL)) {
315       (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
316     }
317   }
318   PetscFunctionReturn(0);
319 }
320 #endif
321 
322 
323 
324