Commit 3d41d9d9 by Uros Bizjak Committed by Uros Bizjak

re PR libfortran/59313 (gfortran.dg/erf_3.F90 FAILs on Solaris/SPARC)

	PR libfortran/59313
	* intrinsics/erfc_scaled.c (erfc_scaled_r16): Also provide for
	quadruple precision long double variant.

From-SVN: r205574
parent 06623961
2013-12-01 Uros Bizjak <ubizjak@gmail.com>
PR libfortran/59313
* intrinsics/erfc_scaled.c (erfc_scaled_r16): Also provide for
quadruple precision long double variant.
2013-11-20 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> 2013-11-20 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
* intrinsics/erfc_scaled.c (erfc_scaled_r16): Don't define if * intrinsics/erfc_scaled.c (erfc_scaled_r16): Don't define if
......
...@@ -45,17 +45,34 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ...@@ -45,17 +45,34 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "erfc_scaled_inc.c" #include "erfc_scaled_inc.c"
#endif #endif
#if defined(HAVE_GFC_REAL_16) && defined(GFC_REAL_16_IS_LONG_DOUBLE) #ifdef HAVE_GFC_REAL_16
#undef KIND
#define KIND 16
#include "erfc_scaled_inc.c"
#endif
/* For quadruple-precision, netlib's implementation is
not accurate enough. We provide another one. */
#ifdef GFC_REAL_16_IS_FLOAT128 #ifdef GFC_REAL_16_IS_FLOAT128
/* For quadruple-precision (__float128), netlib's implementation is # define _THRESH -106.566990228185312813205074546585730Q
not accurate enough. We provide another one. */ # define _M_2_SQRTPI M_2_SQRTPIq
# define _INF __builtin_infq()
# define _ERFC(x) erfcq(x)
# define _EXP(x) expq(x)
#else
# define _THRESH -106.566990228185312813205074546585730L
# define _M_2_SQRTPI M_2_SQRTPIl
# define _INF __builtin_infl()
# ifdef HAVE_ERFCL
# define _ERFC(x) erfcl(x)
# endif
# ifdef HAVE_EXPL
# define _EXP(x) expl(x)
# endif
#endif
#if defined(_ERFC) && defined(_EXP)
extern GFC_REAL_16 erfc_scaled_r16 (GFC_REAL_16); extern GFC_REAL_16 erfc_scaled_r16 (GFC_REAL_16);
export_proto(erfc_scaled_r16); export_proto(erfc_scaled_r16);
...@@ -63,15 +80,15 @@ export_proto(erfc_scaled_r16); ...@@ -63,15 +80,15 @@ export_proto(erfc_scaled_r16);
GFC_REAL_16 GFC_REAL_16
erfc_scaled_r16 (GFC_REAL_16 x) erfc_scaled_r16 (GFC_REAL_16 x)
{ {
if (x < -106.566990228185312813205074546585730Q) if (x < _THRESH)
{ {
return __builtin_infq(); return _INF;
} }
if (x < 12) if (x < 12)
{ {
/* Compute directly as ERFC_SCALED(x) = ERFC(x) * EXP(X**2). /* Compute directly as ERFC_SCALED(x) = ERFC(x) * EXP(X**2).
This is not perfect, but much better than netlib. */ This is not perfect, but much better than netlib. */
return erfcq(x) * expq(x * x); return _ERFC(x) * _EXP(x * x);
} }
else else
{ {
...@@ -97,9 +114,10 @@ erfc_scaled_r16 (GFC_REAL_16 x) ...@@ -97,9 +114,10 @@ erfc_scaled_r16 (GFC_REAL_16 x)
n++; n++;
} }
return (1 + sum) / x * (M_2_SQRTPIq / 2); return (1 + sum) / x * (_M_2_SQRTPI / 2);
} }
} }
#endif #endif
#endif
...@@ -39,7 +39,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see ...@@ -39,7 +39,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
# define EXP(x) exp(x) # define EXP(x) exp(x)
# define TRUNC(x) trunc(x) # define TRUNC(x) trunc(x)
#elif (KIND == 10) || (KIND == 16 && defined(GFC_REAL_16_IS_LONG_DOUBLE)) #elif (KIND == 10)
# ifdef HAVE_EXPL # ifdef HAVE_EXPL
# define EXP(x) expl(x) # define EXP(x) expl(x)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment