ieee_fp: use explicit checks for fpe bits if feenableexcept is not declared

Using isnan and isfinite to check for floating point exceptions
doesn't work when we want floats to be able to have infinity or NaN as
values, thus this option was removed with commit
5f71f728a3. However, we can still use
fetestexcept to explicitly check if floating point exceptions occurred
even when we can't use the feenableexcept/SIGFPE signal delivery
mechanism.

Previously, we had something like this in the
ECL_MATHERR_TEST/ECL_MATHERR_CLEAR macros, but this was not used
consistently in our codebase (the ECL_MATHERR_TEST macro was missing
in many places). Instead of error-prone testing at every point of
computation, we call fetestexcept in DO_DETECT_FPE when creating a new
float/complex float. In order to avoid having to do this twice, the
DO_DETECT_FPE2 macro is introduced.

A minor disadvantage of this strategy is that floating point
exceptions may be signaled later than they occurred.

src/c/hash.d

@@ -13,8 +13,6 @@
  *
  */
 
-/* for ECL_MATHERR_* */
-#define ECL_INCLUDE_MATH_H
 #include <ecl/ecl.h>
 #include <stdlib.h>
 #include <string.h>

src/c/number.d

@@ -29,20 +29,26 @@
  * to be raised when invalid operations are performed.
  */
 #  define DO_DETECT_FPE(f) ecl_detect_fpe()
+#  define DO_DETECT_FPE2(f1,f2) DO_DETECT_FPE(f1)
 # else
 /*
- * Floating point exceptions are disabled
+ * We need explicit checks for floating point exception bits being set
  */
-#  define DO_DETECT_FPE(f)
+#  define DO_DETECT_FPE(f) do {                                   \
+    int status = fetestexcept(ecl_process_env()->trap_fpe_bits);  \
+    unlikely_if (status) ecl_deliver_fpe(status);                 \
+  } while (0)
+#  define DO_DETECT_FPE2(f1,f2) DO_DETECT_FPE(f1)
 # endif
 #else
 /*
  * We do not want IEEE NaNs and infinities
  */
-# define DO_DETECT_FPE(f) do {                                  \
-    unlikely_if (isnan(f)) ecl_deliver_fpe(FE_INVALID);         \
-    unlikely_if (!isfinite(f)) ecl_deliver_fpe(FE_OVERFLOW);    \
+# define DO_DETECT_FPE(f) do {                                   \
+    unlikely_if (isnan(f)) ecl_deliver_fpe(FE_INVALID);          \
+    unlikely_if (!isfinite(f)) ecl_deliver_fpe(FE_OVERFLOW);     \
   } while (0)
+# define DO_DETECT_FPE2(f1,f2) DO_DETECT_FPE(f1); DO_DETECT_FPE(f2)
 #endif
 
 #if !ECL_CAN_INLINE
@@ -618,8 +624,7 @@ si_complex_float(cl_object r, cl_object i)
 }
 
 cl_object ecl_make_csfloat(float _Complex x) {
-  DO_DETECT_FPE(crealf(x));
-  DO_DETECT_FPE(cimagf(x));
+  DO_DETECT_FPE2(crealf(x), cimagf(x));
 
   cl_object c = ecl_alloc_object(t_csfloat);
   ecl_csfloat(c) = x;
@@ -627,8 +632,7 @@ cl_object ecl_make_csfloat(float _Complex x) {
 }
 
 cl_object ecl_make_cdfloat(double _Complex x) {
-  DO_DETECT_FPE(creal(x));
-  DO_DETECT_FPE(cimag(x));
+  DO_DETECT_FPE2(creal(x), cimag(x));
 
   cl_object c = ecl_alloc_object(t_cdfloat);
   ecl_cdfloat(c) = x;
@@ -636,8 +640,7 @@ cl_object ecl_make_cdfloat(double _Complex x) {
 }
 
 cl_object ecl_make_clfloat(long double _Complex x) {
-  DO_DETECT_FPE(creall(x));
-  DO_DETECT_FPE(cimagl(x));
+  DO_DETECT_FPE2(creall(x), cimagl(x));
 
   cl_object c = ecl_alloc_object(t_clfloat);
   ecl_clfloat(c) = x;

src/c/numbers/atan.d

@@ -24,27 +24,23 @@ cl_object
 ecl_atan2(cl_object y, cl_object x)
 {
   cl_object output;
-  ECL_MATHERR_CLEAR;
-  {
-    int tx = ecl_t_of(x);
-    int ty = ecl_t_of(y);
-    if (tx < ty)
-      tx = ty;
-    if (tx == t_longfloat) {
-      long double d = atan2l(ecl_to_long_double(y), ecl_to_long_double(x));
-      output = ecl_make_long_float(d);
+  int tx = ecl_t_of(x);
+  int ty = ecl_t_of(y);
+  if (tx < ty)
+    tx = ty;
+  if (tx == t_longfloat) {
+    long double d = atan2l(ecl_to_long_double(y), ecl_to_long_double(x));
+    output = ecl_make_long_float(d);
+  } else {
+    double dx = ecl_to_double(x);
+    double dy = ecl_to_double(y);
+    double dz = atan2(dy, dx);
+    if (tx == t_doublefloat) {
+      output = ecl_make_double_float(dz);
     } else {
-      double dx = ecl_to_double(x);
-      double dy = ecl_to_double(y);
-      double dz = atan2(dy, dx);
-      if (tx == t_doublefloat) {
-        output = ecl_make_double_float(dz);
-      } else {
-        output = ecl_make_single_float(dz);
-      }
+      output = ecl_make_single_float(dz);
     }
   }
-  ECL_MATHERR_TEST;
   return output;
 }
 

src/c/numbers/expt.d

@@ -100,7 +100,6 @@ ecl_expt_generic(cl_object x, cl_object y) {
   if (minusp) {
     y = ecl_negate(y);
   }
-  ECL_MATHERR_CLEAR;
   do {
     /* INV: ecl_integer_divide outputs an integer */
     if (!ecl_evenp(y)) {
@@ -113,7 +112,6 @@ ecl_expt_generic(cl_object x, cl_object y) {
     }
     x = ecl_times(x, x);
   } while (1);
-  ECL_MATHERR_TEST;
 }
 
 static cl_object

src/h/impl/math_dispatch.h

@@ -63,9 +63,7 @@ typedef cl_object (*math_one_arg_fn)(cl_object);
     cl_object ecl_##name(cl_object arg)                                 \
     {                                                                   \
         cl_object out;                                                  \
-        ECL_MATHERR_CLEAR;                                              \
         out = ecl_##name##_ne(arg);                                     \
-        ECL_MATHERR_TEST;                                               \
         return out;                                                     \
     }
 

src/h/impl/math_fenv.h

@@ -87,17 +87,4 @@
 # define ECL_WITH_LISP_FPE_END } while (0)
 #endif
 
-#if defined(HAVE_FENV_H) && !defined(HAVE_FEENABLEEXCEPT) && !defined(ECL_AVOID_FPE_H)
-# define ECL_USED_EXCEPTIONS (FE_DIVBYZERO|FE_INVALID|FE_OVERFLOW|FE_UNDERFLOW)
-# define ECL_MATHERR_CLEAR feclearexcept(FE_ALL_EXCEPT)
-# define ECL_MATHERR_TEST do {                                  \
-        int bits = fetestexcept(ECL_USED_EXCEPTIONS);           \
-    unlikely_if (bits) ecl_deliver_fpe(bits); } while(0)
-#else
-# define ECL_MATHERR_CLEAR
-# define ECL_MATHERR_TEST
-#endif
-
-extern void ecl_deliver_fpe(int flags);
-
 #endif /* !ECL_MATH_FENV_H */