Actual source code: fp.c

  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
  8: #include <signal.h>
  9: #if defined(PETSC_HAVE_STDLIB_H)
 10: #include <stdlib.h>
 11: #endif

 13: /*--------------------------------------- ---------------------------------------------------*/
 14: #if defined(PETSC_HAVE_SUN4_STYLE_FPTRAP)
 15: #include <floatingpoint.h>

 18: PetscErrorCode ieee_flags(char*,char*,char*,char**);
 19: PetscErrorCode ieee_handler(char *,char *,sigfpe_handler_type(int,int,struct sigcontext*,char *));

 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)

 35: sigfpe_handler_type PetscDefaultFPTrap(int sig,int code,struct sigcontext *scp,char *addr)
 36: {
 38:   int err_ind = -1,j;

 41:   for (j = 0 ; error_codes[j].code_no ; j++) {
 42:     if (error_codes[j].code_no == code) err_ind = j;
 43:   }

 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:   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:   return(0);
 53: }

 57: /*@
 58:    PetscSetFPTrap - Enables traps/exceptions on common floating point errors.
 59:                     This option may not work on certain machines.

 61:    Not Collective

 63:    Input Parameters:
 64: .  flag - PETSC_FP_TRAP_ON, PETSC_FP_TRAP_OFF.

 66:    Options Database Keys:
 67: .  -fp_trap - Activates floating point trapping

 69:    Level: advanced

 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.

 76:    Caution:
 77:    On certain machines, in particular the IBM rs6000, floating point 
 78:    trapping is VERY slow!

 80:    Concepts: floating point exceptions^trapping
 81:    Concepts: divide by zero

 83: @*/
 84: PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
 85: {
 86:   char *out;

 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:   return(0);
105: }

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>

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)

126: void PetscDefaultFPTrap(int sig,siginfo_t *scp,ucontext_t *uap)
127: {
128:   int err_ind,j,code = scp->si_code;

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:   }

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:   PetscError(0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
143:   MPI_Abort(PETSC_COMM_WORLD,0);
144: }

148: PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
149: {
150:   char *out;

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:   return(0);
165: }

167: /* ------------------------------------------------------------------------------------------*/

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: } ;
180: void PetscDefaultFPTrap(unsigned exception[],int val[])
181: {
182:   int err_ind,j,code;

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: }

201: PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
202: {
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:   return(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)

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: */

242: void PetscDefaultFPTrap(int sig,int code,struct sigcontext *scp)
243: {
245:   int      err_ind,j;
246:   fp_ctx_t flt_context;

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:   }

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:   PetscError(0,"User provided function","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
262:   MPI_Abort(PETSC_COMM_WORLD,0);
263: }

267: PetscErrorCode PetscSetFPTrap(PetscFPTrap on)
268: {
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:   return(0);
289: }

291: /* -------------------------Default -----------------------------------*/
292: #else 
296: void PetscDefaultFPTrap(int sig)
297: {
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: }
306: PetscErrorCode  PetscSetFPTrap(PetscFPTrap on)
307: {
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:   return(0);
319: }
320: #endif