From @dcollinsn

0001-RT-128643.patch

From 89699407814eee4c9d12ec8499104e1c8fb9b8ff Mon Sep 17 00:00:00 2001
From: Dan Collins <dcollinsn@gmail.com>
Date: Sun, 17 Jul 2016 12:37:46 -0400
Subject: [PATCH] [RT #128643] Win32: Provide my_powl to replace broken MinGW

The powl() provided by MinGW is broken: under at least some situations,
it fails to overflow from LDBL_MAX to INF. This was noticed because
the test suite uses 9**9**9 as something that "should be" inf, and
MinGW returned LDBL_MAX instead. This patch provides a powl() from
MinGW-w64, conditionally including it whenever long doubles are in
use on a MinGW platform.

This issue has been reported to MinGW as bug #2306. However, in the
interim, this patch allows Perl to build and test successfully on
that platform. Once that ticket is resolved upstream, we can update
core to only provide this function on broken versions of MinGW, for
now, the test is gated on all versions.
---
 embed.fnc     |   3 ++
 embed.h       |   3 ++
 makedef.pl    |   3 ++
 proto.h       |   3 ++
 win32/win32.c | 155 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 win32/win32.h |  14 ++++++
 6 files changed, 181 insertions(+)

diff --git a/embed.fnc b/embed.fnc
index abc1187..915bbf2 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -978,6 +978,9 @@ Ap	|I32	|my_pclose	|NULLOK PerlIO* ptr
 Ap	|PerlIO*|my_popen	|NN const char* cmd|NN const char* mode
 #endif
 Ap	|PerlIO*|my_popen_list	|NN const char* mode|int n|NN SV ** args
+#if defined(USE_LONG_DOUBLE) && defined(__MINGW32_VERSION_MAJOR) && !defined(__MINGW64_VERSION_MAJOR)
+A	|long double	|my_powl	|long double x|long double y
+#endif
 Ap	|void	|my_setenv	|NULLOK const char* nam|NULLOK const char* val
 Apmb	|I32	|my_stat
 pX	|I32	|my_stat_flags	|NULLOK const U32 flags
diff --git a/embed.h b/embed.h
index b440509..48e1d15 100644
--- a/embed.h
+++ b/embed.h
@@ -894,6 +894,9 @@
 #if defined(USE_LOCALE_COLLATE)
 #define sv_collxfrm_flags(a,b,c)	Perl_sv_collxfrm_flags(aTHX_ a,b,c)
 #endif
+#if defined(USE_LONG_DOUBLE) && defined(__MINGW32_VERSION_MAJOR) && !defined(__MINGW64_VERSION_MAJOR)
+#define my_powl(a,b)		my_powl(aTHX_ a,b)
+#endif
 #if defined(USE_PERLIO)
 #define PerlIO_clearerr(a)	Perl_PerlIO_clearerr(aTHX_ a)
 #define PerlIO_close(a)		Perl_PerlIO_close(aTHX_ a)
diff --git a/makedef.pl b/makedef.pl
index 956914e..671d644 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -561,6 +561,9 @@ if ($define{'PERL_GLOBAL_STRUCT'}) {
     ++$skip{$_} foreach qw(Perl_init_global_struct Perl_free_global_struct);
 }
 
+++$skip{my_powl}
+    unless $define{USE_LONG_DOUBLE} && $define{__MINGW32_VERSION_MAJOR} && !$define{__MINGW64_VERSION_MAJOR};
+
 ++$skip{PL_op_exec_cnt}
     unless $define{PERL_TRACE_OPS};
 
diff --git a/proto.h b/proto.h
index ec2ae33..21c8357 100644
--- a/proto.h
+++ b/proto.h
@@ -5808,6 +5808,9 @@ PERL_CALLCONV char*	Perl_sv_collxfrm_flags(pTHX_ SV *const sv, STRLEN *const nxp
 #define PERL_ARGS_ASSERT_SV_COLLXFRM_FLAGS	\
 	assert(sv); assert(nxp)
 #endif
+#if defined(USE_LONG_DOUBLE) && defined(__MINGW32_VERSION_MAJOR) && !defined(__MINGW64_VERSION_MAJOR)
+PERL_CALLCONV long double	my_powl(pTHX_ long double x, long double y);
+#endif
 #if defined(USE_PERLIO)
 PERL_CALLCONV void	Perl_PerlIO_clearerr(pTHX_ PerlIO *f);
 PERL_CALLCONV int	Perl_PerlIO_close(pTHX_ PerlIO *f);
diff --git a/win32/win32.c b/win32/win32.c
index 6ac73e2..20a28e5 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -4795,3 +4795,158 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
 }
 #  endif /* USE_ITHREADS */
 #endif /* HAVE_INTERP_INTERN */
+
+#if defined(USE_LONG_DOUBLE) && defined(__MINGW32_VERSION_MAJOR) && !defined(__MINGW64_VERSION_MAJOR)
+/* NAN builtins for gcc, as they are not part of math.h  */
+#ifndef NANF
+#define NANF __builtin_nanf ("")
+#endif
+#ifndef NANL
+#define NANL __builtin_nanl ("")
+#endif
+
+
+#ifndef _SET_ERRNO
+#define _SET_ERRNO(x) errno = (x)
+#endif
+
+
+static long double
+internal_modf (long double value, long double *iptr)
+{
+  long double int_part = (long double) 0.0;
+#ifdef _WIN64
+  asm ("pushq %%rax\n\tsubq $8, %%rsp\n"
+    "fnstcw 4(%%rsp)\n"
+    "movzwl 4(%%rsp), %%eax\n"
+    "orb $12, %%ah\n"
+    "movw %%ax, (%%rsp)\n"
+    "fldcw (%%rsp)\n"
+    "frndint\n"
+    "fldcw 4(%%rsp)\n"
+    "addq $8, %%rsp\npopq %%rax" : "=t" (int_part) : "0" (value)); /* round */
+#else
+  asm ("push %%eax\n\tsubl $8, %%esp\n"
+    "fnstcw 4(%%esp)\n"
+    "movzwl 4(%%esp), %%eax\n"
+    "orb $12, %%ah\n"
+    "movw %%ax, (%%esp)\n"
+    "fldcw (%%esp)\n"
+    "frndint\n"
+    "fldcw 4(%%esp)\n"
+    "addl $8, %%esp\n\tpop %%eax\n" : "=t" (int_part) : "0" (value)); /* round */
+#endif
+  if (iptr)
+    *iptr = int_part;
+  return (isinf (value) ?  (long double) 0.0 : value - int_part);
+}
+
+long double __powil (long double x, int n);
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+long double __cdecl
+my_powl (long double x, long double y)
+{
+  int x_class = fpclassify (x);
+  int y_class = fpclassify (y);
+  long odd_y = 0;
+  long double d, rslt;
+
+  if (y_class == FP_ZERO || x == 1.0L)
+    return 1.0L;
+  else if (x_class == FP_NAN || y_class == FP_NAN)
+    {
+      rslt = (signbit(x) ? -NANL : NANL);
+      _SET_ERRNO (EDOM);
+      return rslt;
+    }
+  else if (x_class == FP_ZERO)
+    {
+      if (y_class == FP_INFINITE)
+        return (signbit(y) ? HUGE_VALL : 0.0L);
+
+      if (signbit(x) && internal_modf (y, &d) != 0.0)
+        {
+          return signbit (y) ? (1.0 / -x) : 0.0L;
+        }
+      odd_y = (internal_modf (ldexpl (y, -1), &d) != 0.0) ? 1 : 0;
+      if (!signbit(y))
+        {
+          if (!odd_y || !signbit (x))
+            return 0.0L;
+          return -0.0L;
+        }
+
+      if (!odd_y || !signbit (x))
+        return HUGE_VALL;
+      return (signbit(x) ? -HUGE_VALL : HUGE_VALL);
+    }
+  else if (y_class == FP_INFINITE)
+    {
+      long double a_x;
+
+      if (x_class == FP_INFINITE)
+        return (signbit (y) ? 0.0L : HUGE_VALL);
+      a_x = (signbit (x) ? -x : x);
+      if (a_x == 1.0)
+        return 1.0L;
+      if (a_x > 1.0)
+        return (signbit (y) == 0 ? HUGE_VALL : 0.0L);
+      return (!signbit (y) ? 0.0L : HUGE_VALL);
+    }
+  else if (x_class == FP_INFINITE)
+    {
+      /* pow (x, y) signals the invalid operation exception for finite x < 0 and finite non-integer y.  */
+      if (signbit(x) && internal_modf (y, &d) != 0.0)
+        {
+          return signbit(y) ? 1.0 / -x : -x;
+        }
+      odd_y = (internal_modf (ldexpl (y, -1), &d) != 0.0) ? 1 : 0;
+      /* pow( -inf, y) = +0 for y<0 and not an odd integer,  */
+      if (signbit(x) && signbit(y) && !odd_y)
+        return 0.0L;
+      /* pow( -inf, y) = -inf for y an odd integer > 0.  */
+      if (signbit(x) && !signbit(y) && odd_y)
+        return -HUGE_VALL;
+      /* pow( -inf, y) = +inf for y>0 and not an odd integer.  */
+      if (signbit(x) && !signbit(y) && !odd_y)
+        return HUGE_VALL;
+      /* pow (+/-inf, y) is +/-0 with no exception for y an odd integer < 0. */
+      if (signbit(y))
+      {
+        /* pow (+/-inf, y) is +0 with no exception for finite y < 0 and not an odd integer.  */
+        return (odd_y && signbit(x) ? -0.0L : 0.0L);
+      }
+      /* pow (+/-inf, y) is +/-inf with no exception for finite y > 0 an odd integer.  */
+      /* pow (+/-inf, y) is +inf with no exception for finite y > 0 and not an odd integer.  */
+      return (odd_y && signbit(x) ? -HUGE_VALL : HUGE_VALL);
+    }
+
+  if (internal_modf (y, &d) != 0.0)
+    {
+      if (signbit (x))
+        {
+          _SET_ERRNO (EDOM);
+          return -NANL;
+        }
+      if (y == 0.5L)
+        {
+          asm ("fsqrt" : "=t" (rslt) : "0" (x));
+          return rslt;
+        }
+    }
+  else if ((d <= (long double) INT_MAX && d >= (long double) INT_MIN))
+     return __powil (x, (int) y);
+  /* As exp already checks for minlog and maxlog no further checks are necessary.  */
+  rslt = (long double) exp2l ((long double) y * log2l ((long double) fabsl (x)));
+
+  if (signbit (x) && internal_modf (ldexpl (y, -1), &d) != 0.0)
+    rslt = -rslt;
+  return rslt;
+}
+#ifdef __cplusplus
+}
+#endif
+#endif
\ No newline at end of file
diff --git a/win32/win32.h b/win32/win32.h
index 9b79e00..1d1dbb0 100644
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -662,5 +662,19 @@ DllExport void *win32_signal_context(void);
 #define Win_CreateSemaphore   CreateSemaphore
 #endif
 
+#if defined(USE_LONG_DOUBLE) && defined(__MINGW32_VERSION_MAJOR) && !defined(__MINGW64_VERSION_MAJOR)
+/* MinGW.org provides a powl that is broken: 9**9**9 returns
+ * LDBL_MAX instead of INF.
+ */
+#define powl my_powl
+#ifdef __cplusplus
+extern "C" {
+#endif
+long double __cdecl my_powl (long double x, long double y);
+#ifdef __cplusplus
+}
+#endif
+#endif
+
 #endif /* _INC_WIN32_PERL5 */
 
-- 
2.8.3

MinGW.org builds - infnan and pack test failures due to LD handling #15453

Description

Metadata

Metadata

Assignees

Labels

Type

Projects

Milestone

Relationships

Development

Issue actions