Actual source code: fp.c

  1: /*$Id: fp.c,v 1.79 2001/08/15 20:12:54 balay Exp $*/
  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 petsc.h
 8:  #include petscsys.h
  9: #include <signal.h>
 10: #if defined(PETSC_HAVE_STDLIB_H)
 11: #include <stdlib.h>
 12: #endif
 13: #include "petscfix.h"


 16: /*--------------------------------------- ---------------------------------------------------*/
 17: #if defined(PETSC_HAVE_SUN4_STYLE_FPTRAP)
 18: #include <floatingpoint.h>

 20: EXTERN_C_BEGIN
 21: int ieee_flags(char*,char*,char*,char**);
 22: int ieee_handler(char *,char *,sigfpe_handler_type(int,int,struct sigcontext*,char *));
 23: EXTERN_C_END

 25: struct { int code_no; char *name; } error_codes[] = {
 26:            { FPE_INTDIV_TRAP        ,"integer divide" },
 27:            { FPE_FLTOPERR_TRAP        ,"IEEE operand error" },
 28:            { FPE_FLTOVF_TRAP        ,"floating point overflow" },
 29:            { FPE_FLTUND_TRAP        ,"floating point underflow" },
 30:            { FPE_FLTDIV_TRAP        ,"floating pointing divide" },
 31:            { FPE_FLTINEX_TRAP        ,"inexact floating point result" },
 32:            { 0                        ,"unknown error" }
 33: } ;
 34: #define SIGPC(scp) (scp->sc_pc)

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

 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,"unknownfunction","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
 51:   MPI_Abort(PETSC_COMM_WORLD,0);
 52:   return(0);
 53: }

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

 59:    Not Collective

 61:    Input Parameters:
 62: .  flag - PETSC_FP_TRAP_ON, PETSC_FP_TRAP_OFF.

 64:    Options Database Keys:
 65: .  -fp_trap - Activates floating point trapping

 67:    Level: advanced

 69:    Description:
 70:    On systems that support it, this routine causes floating point
 71:    overflow, divide-by-zero, and invalid-operand (e.g., a NaN) to
 72:    cause a message to be printed and the program to exit.

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

 78:    Concepts: floating point exceptions^trapping
 79:    Concepts: divide by zero

 81: @*/
 82: int PetscSetFPTrap(PetscFPTrap flag)
 83: {
 84:   char *out;

 87:   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
 88:   (void) ieee_flags("clear","exception","all",&out);
 89:   if (flag == PETSC_FP_TRAP_ON) {
 90:     if (ieee_handler("set","common",PetscDefaultFPTrap)) {
 91:       /*
 92:         To trap more fp exceptions, including undrflow, change the above line to
 93:         if (ieee_handler("set","all",PetscDefaultFPTrap)) {
 94:       */
 95:       (*PetscErrorPrintf)("Can't set floatingpoint handlern");
 96:     }
 97:   } else {
 98:     if (ieee_handler("clear","common",PetscDefaultFPTrap)) {
 99:       (*PetscErrorPrintf)("Can't clear floatingpoint handlern");
100:     }
101:   }
102:   return(0);
103: }

105: /* -------------------------------------------------------------------------------------------*/
106: #elif defined(PETSC_HAVE_SOLARIS_STYLE_FPTRAP)
107: #include <sunmath.h>
108: #include <floatingpoint.h>
109: #include <siginfo.h>
110: #include <ucontext.h>

112: struct { int code_no; char *name; } error_codes[] = {
113:   {  FPE_FLTINV,"invalid floating point operand"},
114:   {  FPE_FLTRES,"inexact floating point result"},
115:   {  FPE_FLTDIV,"division-by-zero"},
116:   {  FPE_FLTUND,"floating point underflow"},
117:   {  FPE_FLTOVF,"floating point overflow"},
118:   {  0,         "unknown error"}
119: };
120: #define SIGPC(scp) (scp->si_addr)

122: void PetscDefaultFPTrap(int sig,siginfo_t *scp,ucontext_t *uap)
123: {
124:   int err_ind,j,ierr,code = scp->si_code;

127:   err_ind = -1 ;
128:   for (j = 0 ; error_codes[j].code_no ; j++) {
129:     if (error_codes[j].code_no == code) err_ind = j;
130:   }

132:   if (err_ind >= 0) {
133:     (*PetscErrorPrintf)("*** %s occurred at pc=%X ***n",error_codes[err_ind].name,SIGPC(scp));
134:   } else {
135:     (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***n",code,SIGPC(scp));
136:   }
137:   PetscError(0,"unknownfunction","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
138:   MPI_Abort(PETSC_COMM_WORLD,0);
139: }

141: int PetscSetFPTrap(PetscFPTrap flag)
142: {
143:   char *out;

146:   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
147:   (void) ieee_flags("clear","exception","all",&out);
148:   if (flag == PETSC_FP_TRAP_ON) {
149:     if (ieee_handler("set","common",(sigfpe_handler_type)PetscDefaultFPTrap)) {
150:       (*PetscErrorPrintf)("Can't set floating point handlern");
151:     }
152:   } else {
153:     if (ieee_handler("clear","common",(sigfpe_handler_type)PetscDefaultFPTrap)) {
154:      (*PetscErrorPrintf)("Can't clear floatingpoint handlern");
155:     }
156:   }
157:   return(0);
158: }

160: /* ------------------------------------------------------------------------------------------*/

162: #elif defined (PETSC_HAVE_IRIX_STYLE_FPTRAP)
163: #include <sigfpe.h>
164: struct { int code_no; char *name; } error_codes[] = {
165:        { _INVALID   ,"IEEE operand error" },
166:        { _OVERFL    ,"floating point overflow" },
167:        { _UNDERFL   ,"floating point underflow" },
168:        { _DIVZERO   ,"floating point divide" },
169:        { 0          ,"unknown error" }
170: } ;
171: void PetscDefaultFPTrap(unsigned exception[],int val[])
172: {
173:   int err_ind,j,code;

176:   code = exception[0];
177:   err_ind = -1 ;
178:   for (j = 0 ; error_codes[j].code_no ; j++){
179:     if (error_codes[j].code_no == code) err_ind = j;
180:   }
181:   if (err_ind >= 0){
182:     (*PetscErrorPrintf)("*** %s occurred ***n",error_codes[err_ind].name);
183:   } else{
184:     (*PetscErrorPrintf)("*** floating point error 0x%x occurred ***n",code);
185:   }
186:   PetscError(0,"unknownfunction","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
187:   MPI_Abort(PETSC_COMM_WORLD,0);
188: }

190: int PetscSetFPTrap(PetscFPTrap flag)
191: {
193:   if (flag == PETSC_FP_TRAP_ON) {
194:     handle_sigfpes(_ON,_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,PetscDefaultFPTrap,_ABORT_ON_ERROR,0);
195:   } else {
196:     handle_sigfpes(_OFF,_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,0,_ABORT_ON_ERROR,0);
197:   }
198:   return(0);
199: }
200: /*----------------------------------------------- --------------------------------------------*/
201: /* In "fast" mode, floating point traps are imprecise and ignored.
202:    This is the reason for the fptrap(FP_TRAP_SYNC) call */
203: #elif defined(PETSC_HAVE_RS6000_STYLE_FPTRAP) 
204: struct sigcontext;
205: #include <fpxcp.h>
206: #include <fptrap.h>
207: #include <stdlib.h>
208: #define FPE_FLTOPERR_TRAP (fptrap_t)(0x20000000)
209: #define FPE_FLTOVF_TRAP   (fptrap_t)(0x10000000)
210: #define FPE_FLTUND_TRAP   (fptrap_t)(0x08000000)
211: #define FPE_FLTDIV_TRAP   (fptrap_t)(0x04000000)
212: #define FPE_FLTINEX_TRAP  (fptrap_t)(0x02000000)

214: struct { int code_no; char *name; } error_codes[] = {
215:            {FPE_FLTOPERR_TRAP        ,"IEEE operand error" },
216:            { FPE_FLTOVF_TRAP        ,"floating point overflow" },
217:            { FPE_FLTUND_TRAP        ,"floating point underflow" },
218:            { FPE_FLTDIV_TRAP        ,"floating point divide" },
219:            { FPE_FLTINEX_TRAP        ,"inexact floating point result" },
220:            { 0                        ,"unknown error" }
221: } ;
222: #define SIGPC(scp) (0) /* Info MIGHT be in scp->sc_jmpbuf.jmp_context.iar */
223: /* 
224:    For some reason, scp->sc_jmpbuf does not work on the RS6000, even though
225:    it looks like it should from the include definitions.  It is probably
226:    some strange interaction with the "POSIX_SOURCE" that we require.
227: */

229: void PetscDefaultFPTrap(int sig,int code,struct sigcontext *scp)
230: {
231:   int      ierr,err_ind,j;
232:   fp_ctx_t flt_context;

235:   fp_sh_trap_info(scp,&flt_context);
236: 
237:   err_ind = -1 ;
238:   for (j = 0 ; error_codes[j].code_no ; j++) {
239:     if (error_codes[j].code_no == flt_context.trap) err_ind = j;
240:   }

242:   if (err_ind >= 0){
243:     (*PetscErrorPrintf)("*** %s occurred ***n",error_codes[err_ind].name);
244:   } else{
245:     (*PetscErrorPrintf)("*** floating point error 0x%x occurred ***n",flt_context.trap);
246:   }
247:   PetscError(0,"unknownfunction","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
248:   MPI_Abort(PETSC_COMM_WORLD,0);
249: }

251: int PetscSetFPTrap(PetscFPTrap on)
252: {
253:   int flag;

256:   if (on == PETSC_FP_TRAP_ON) {
257:     signal(SIGFPE,(void (*)(int))PetscDefaultFPTrap);
258:     fp_trap(FP_TRAP_SYNC);
259:     fp_enable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW);
260:     /* fp_enable(mask) for individual traps.  Values are:
261:        TRP_INVALID
262:        TRP_DIV_BY_ZERO
263:        TRP_OVERFLOW
264:        TRP_UNDERFLOW
265:        TRP_INEXACT
266:        Can OR then together.
267:        fp_enable_all(); for all traps.
268:     */
269:   } else {
270:     signal(SIGFPE,SIG_DFL);
271:     fp_disable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW);
272:     fp_trap(FP_TRAP_OFF);
273:   }
274:   return(0);
275: }

277: /* -------------------------Default -----------------------------------*/
278: #else 
279: struct { int code_no; char *name; } error_codes[] = {
280:            { 0                ,"unknown error" }
281: } ;
282: void PetscDefaultFPTrap(int sig)
283: {
285:   (*PetscErrorPrintf)("*** floating point error occurred ***n");
286:   PetscError(0,"unknownfunction","Unknown file","Unknown directory",PETSC_ERR_FP,1,"floating point error");
287:   MPI_Abort(PETSC_COMM_WORLD,0);
288: }
289: int PetscSetFPTrap(PetscFPTrap on)
290: {
292:   if (on == PETSC_FP_TRAP_ON) {
293:     if (SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap)) {
294:       (*PetscErrorPrintf)("Can't set floatingpoint handlern");
295:     }
296:   } else {
297:     if (SIG_ERR == signal(SIGFPE,SIG_DFL)) {
298:       (*PetscErrorPrintf)("Can't clear floatingpoint handlern");
299:     }
300:   }
301:   return(0);
302: }
303: #endif