This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
POSIX math: fpclassify emulation.
authorJarkko Hietaniemi <jhi@iki.fi>
Sat, 30 Aug 2014 12:54:19 +0000 (08:54 -0400)
committerJarkko Hietaniemi <jhi@iki.fi>
Sun, 31 Aug 2014 21:53:07 +0000 (17:53 -0400)
ext/POSIX/POSIX.xs

index aac2608..e5a9aa6 100644 (file)
 #  define M_SQRT1_2    0.707106781186547524400844362104849039
 #endif
 
+/* We will have an emulation. */
+#if !defined(HAS_FPCLASSIFY) && !defined(FP_INFINITE)
+#  define FP_INFINITE  0
+#  define FP_NAN       1
+#  define FP_NORMAL    2
+#  define FP_SUBNORMAL 3
+#  define FP_ZERO      4
+#endif
+
 /* C89 math.h:
 
    acos asin atan atan2 ceil cos cosh exp fabs floor fmod frexp ldexp
@@ -422,6 +431,65 @@ static NV my_fmin(NV x, NV y)
 #  define c99_fmin my_fmin
 #endif
 
+#ifndef HAS_FPCLASSIFY
+static NV my_fpclassify(NV x)
+{
+#if (defined(HAS_FPCLASS) || defined(HAS_FPCLASSL)) && defined(FP_CLASS_SNAN)
+  switch (Perl_fp_class(x)) {
+  case FP_CLASS_NINF:    case FP_CLASS_PINF:    return FP_INFINITE;
+  case FP_CLASS_SNAN:    case FP_CLASS_QNAN:    return FP_NAN;
+  case FP_CLASS_NNORM:   case FP_CLASS_PNORM:   return FP_NORMAL;
+  case FP_CLASS_NDENORM: case FP_CLASS_PDENORM: return FP_SUBNORMAL;
+  case FP_CLASS_NZERO:   case FP_CLASS_PZERO:   return FP_ZERO;
+  default: return -1;
+  }
+#  define c99_fpclassify my_fpclassify
+#elif (defined(HAS_FPCLASS) || defined(HAS_FP_CLASSL)) && defined(FP_SNAN)
+  switch (Perl_fp_class(x)) {
+  case FP_NINF:    case FP_PINF:    return FP_INFINITE;
+  case FP_SNAN:    case FP_QNAN:    return FP_NAN;
+  case FP_NNORM:   case FP_PNORM:   return FP_NORMAL;
+  case FP_NDENORM: case FP_PDENORM: return FP_SUBNORMAL;
+  case FP_NZERO:   case FP_PZERO:   return FP_ZERO;
+  default: return -1;
+  }
+#  define c99_fpclassify my_fpclassify
+#elif defined(HAS_FP_CLASS) && defined(FP_POS_INF)
+  switch (Perl_fp_class(x)) {
+  case FP_NEG_INF:    case FP_POS_INF:    return FP_INFINITE;
+  case FP_SNAN:       case FP_QNAN:       return FP_NAN;
+  case FP_NEG_NORM:   case FP_POS_NORM:   return FP_NORMAL;
+  case FP_NEG_DENORM: case FP_POS_DENORM: return FP_SUBNORMAL;
+  case FP_NEG_ZERO:   case FP_POS_ZERO:   return FP_ZERO;
+  default: return -1;
+  }
+#  define c99_fpclassify my_fpclassify
+#elif defined(HAS_CLASS) && defined(FP_PLUS_INF)
+  switch (Perl_fp_class(x)) {
+  case FP_MINUS_INF:    case FP_PLUS_INF:    return FP_INFINITE;
+  case FP_SNAN:         case FP_QNAN:        return FP_NAN;
+  case FP_MINUS_NORM:   case FP_PLUS_NORM:   return FP_NORMAL;
+  case FP_MINUS_DENORM: case FP_PLUS_DENORM: return FP_SUBNORMAL;
+  case FP_MINUS_ZERO:   case FP_PLUS_ZERO:   return FP_ZERO;
+  default: return -1;
+  }
+#  define c99_fpclassify my_fpclassify
+#elif defined(HAS_FP_CLASSIFY)
+  return Perl_fp_class(x);
+#  define c99_fpclassify my_fpclassify
+#elif defined(WIN32)
+  int fpclass = _fpclass(x);
+  if (Perl_fp_class_inf(x))    return FP_INFINITE;
+  if (Perl_fp_class_nan(x))    return FP_NAN;
+  if (Perl_fp_class_norm(x))   return FP_NORMAL;
+  if (Perl_fp_class_denorm(x)) return FP_SUBNORMAL;
+  if (Perl_fp_class_zero(x))   return FP_ZERO;
+  return -1;
+#  define c99_fpclassify my_fpclassify
+#endif
+}
+#endif
+
 #ifndef c99_hypot
 static NV my_hypot(NV x, NV y)
 {