| 1 | |
| 2 | /******************************************** |
| 3 | matherr.c |
| 4 | copyright 1991, Michael D. Brennan |
| 5 | |
| 6 | This is a source file for mawk, an implementation of |
| 7 | the AWK programming language. |
| 8 | |
| 9 | Mawk is distributed without warranty under the terms of |
| 10 | the GNU General Public License, version 2, 1991. |
| 11 | ********************************************/ |
| 12 | |
| 13 | /*$Log: matherr.c,v $ |
| 14 | * Revision 1.2 1992/06/02 05:07:35 rich |
| 15 | * Ported to 386bsd. Changes from vax BSD4.3 include usage of |
| 16 | * fmod in libm.a, usage of void pointers, and usage of vfprintf |
| 17 | * in libc.a. Floating point exceptions are not raised when |
| 18 | * they should be, which causes the last fpe test to fail. |
| 19 | * |
| 20 | * Revision 5.1 91/12/05 07:56:18 brennan |
| 21 | * 1.1 pre-release |
| 22 | * |
| 23 | */ |
| 24 | |
| 25 | #include "mawk.h" |
| 26 | #include <math.h> |
| 27 | |
| 28 | #if FPE_TRAPS_ON |
| 29 | #include <signal.h> |
| 30 | |
| 31 | /* machine dependent changes might be needed here */ |
| 32 | |
| 33 | static void fpe_catch( signal, why) |
| 34 | int signal, why ; |
| 35 | { |
| 36 | |
| 37 | #if NOINFO_SIGFPE |
| 38 | /* some systems give no hook to find out what the exception |
| 39 | was -- stuff like this is why people still use fortran |
| 40 | |
| 41 | If this fits, #define NOINFO_SIGFPE 1 in your config.h |
| 42 | */ |
| 43 | rt_error("floating point exception, probably overflow") ; |
| 44 | #else |
| 45 | |
| 46 | switch(why) |
| 47 | { |
| 48 | case FPE_INTDIV_TRAP : |
| 49 | case FPE_FLTDIV_TRAP : |
| 50 | rt_error("division by zero") ; |
| 51 | |
| 52 | case FPE_INTOVF_TRAP : |
| 53 | case FPE_FLTOVF_TRAP : |
| 54 | rt_error("floating point overflow") ; |
| 55 | |
| 56 | default : |
| 57 | rt_error("floating point exception") ; |
| 58 | } |
| 59 | #endif |
| 60 | } |
| 61 | |
| 62 | void fpe_init() |
| 63 | { (void) signal(SIGFPE, fpe_catch) ; } |
| 64 | |
| 65 | #else /* FPE_TRAPS_ON==0 */ |
| 66 | |
| 67 | void fpe_init() |
| 68 | { |
| 69 | TURN_OFF_FPE_TRAPS() ; |
| 70 | } |
| 71 | #endif |
| 72 | |
| 73 | #if HAVE_MATHERR |
| 74 | |
| 75 | #if ! FPE_TRAPS_ON |
| 76 | |
| 77 | /* If we are not trapping math errors, we will shutup the library calls |
| 78 | */ |
| 79 | |
| 80 | int matherr( e ) |
| 81 | struct exception *e ; |
| 82 | { return 1 ; } |
| 83 | |
| 84 | #else /* print error message and exit */ |
| 85 | |
| 86 | int matherr( e ) |
| 87 | struct exception *e ; |
| 88 | { char *error ; |
| 89 | |
| 90 | switch( e->type ) |
| 91 | { |
| 92 | case DOMAIN : |
| 93 | case SING : |
| 94 | error = "domain error" ; |
| 95 | break ; |
| 96 | |
| 97 | case OVERFLOW : |
| 98 | error = "overflow" ; |
| 99 | break ; |
| 100 | |
| 101 | case TLOSS : |
| 102 | case PLOSS : |
| 103 | error = "loss of significance" ; |
| 104 | break ; |
| 105 | |
| 106 | case UNDERFLOW : |
| 107 | e->retval = 0.0 ; |
| 108 | return 1 ; /* ignore it */ |
| 109 | } |
| 110 | |
| 111 | if ( strcmp(e->name, "atan2") == 0 ) |
| 112 | rt_error("atan2(%g,%g) : %s" , |
| 113 | e->arg1, e->arg2, error ) ; |
| 114 | else |
| 115 | rt_error("%s(%g) : %s" , e->name, e->arg1, error) ; |
| 116 | |
| 117 | /* won't get here */ |
| 118 | return 0 ; |
| 119 | } |
| 120 | #endif /* FPE_TRAPS */ |
| 121 | |
| 122 | #endif /* HAVE_MATHERR */ |
| 123 | |
| 124 | |
| 125 | /* this is how one gets the libm calls to do the right |
| 126 | thing on bsd43_vax |
| 127 | */ |
| 128 | |
| 129 | #ifdef BSD43_VAX |
| 130 | |
| 131 | #include <errno.h> |
| 132 | |
| 133 | double infnan( arg ) |
| 134 | int arg ; |
| 135 | { |
| 136 | switch(arg) |
| 137 | { |
| 138 | case ERANGE : errno = ERANGE ; return HUGE ; |
| 139 | case -ERANGE : errno = EDOM ; return -HUGE ; |
| 140 | default : errno = EDOM ; |
| 141 | } |
| 142 | return 0.0 ; |
| 143 | } |
| 144 | |
| 145 | #endif /* BSD43_VAX */ |
| 146 | |
| 147 | /* This routine is for XENIX-68K 2.3A. |
| 148 | Error check routine to be called after fp arithmetic. |
| 149 | */ |
| 150 | |
| 151 | #if SW_FP_CHECK |
| 152 | /* Definitions of bit values in iserr() return value */ |
| 153 | |
| 154 | #define OVFLOW 2 |
| 155 | #define UFLOW 4 |
| 156 | #define ZERODIV 8 |
| 157 | #define OVFLFIX 32 |
| 158 | #define INFNAN 64 |
| 159 | |
| 160 | void |
| 161 | fpcheck() |
| 162 | { |
| 163 | register int fperrval ; |
| 164 | char *errdesc ; |
| 165 | |
| 166 | if ((fperrval = iserr()) == 0) |
| 167 | return ; /* no error */ |
| 168 | |
| 169 | errdesc = (char *) 0 ; |
| 170 | |
| 171 | if (fperrval & INFNAN) |
| 172 | errdesc = "arg is infinity or NAN" ; |
| 173 | else if (fperrval & ZERODIV) |
| 174 | errdesc = "division by zero" ; |
| 175 | else if (fperrval & OVFLOW) |
| 176 | errdesc = "overflow" ; |
| 177 | else if (fperrval & UFLOW) |
| 178 | ; /* ignored */ |
| 179 | |
| 180 | if (errdesc) |
| 181 | rt_error("%s", errdesc) ; |
| 182 | } |
| 183 | |
| 184 | #endif |