1ec601bf9f
/ 2010-11-13 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> Tobias Burnus <burnus@net-b.de> PR fortran/32049 * Makefile.def: Add libquadmath; build it with language=fortran. * configure.ac: Add libquadmath. * Makefile.tpl: Handle multiple libs in check-[+language+]. * Makefile.in: Regenerate. * configure: Regenerate. libquadmath/ 2010-11-13 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> Tobias Burnus <burnus@net-b.de> PR fortran/32049 Initial implementation and checkin. gcc/fortran/ 2010-11-13 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> Tobias Burnus <burnus@net-b.de> PR fortran/32049 * gfortranspec.c (find_spec_file): New function. (lang_specific_driver): Try to find .spec file and use it. * trans-io.c (iocall): Define * IOCALL_X_REAL128/COMPLEX128(,write). (gfc_build_io_library_fndecls): Build decl for __float128 I/O. (transfer_expr): Call __float128 I/O functions. * trans-types.c (gfc_init_kinds): Allow kind-16 belonging to __float128. gcc/testsuite/ 2010-11-13 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> Tobias Burnus <burnus@net-b.de> PR fortran/32049 * gfortran.dg/quad_1.f90: New. * lib/gcc-defs.exp (gcc-set-multilib-library-path): Use also compiler arguments. * lib/gfortran.exp (gfortran_link_flags): Add libquadmath to library search path; call gcc-set-multilib-library-path with arguments such that libgfortran.spec is found. (gfortran_init): Add path for libgfortran.spec to GFORTRAN_UNDER_TEST. libgomp/ 2010-11-13 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> Tobias Burnus <burnus@net-b.de> PR fortran/32049 * configure.ac: * configure: Regenerate. libgfortran/ 2010-11-13 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> Tobias Burnus <burnus@net-b.de> PR fortran/32049 * Makefile.am: Add missing pow_r16_i4.c, add transfer128.c, link libquadmath, if used. * acinclude.m4 (LIBGFOR_CHECK_FLOAT128): Add. * configure.ac: Use it, touch spec file. * gfortran.map: Add pow_r16_i4 and transfer_(real,complex)128(,write) functions. * intrinsics/cshift0.c (cshift0): Handle __float128 type. * intrinsics/erfc_scaled_inc.c: Ditto. * intrinsics/pack_generic.c (pack): Ditto * intrinsics/spread_generic.c (spread): Ditto. * intrinsics/unpack_generic.c (unpack1): Ditto. * io/read.c (convert_real): Ditto. * io/transfer.c: Update comments. * io/transfer128.c: New file. * io/write_float.def (write_float): Handle __float128 type. * libgfortran.h: #include quadmath_weak.h, define __builtin_infq and nanq. * m4/mtype.m4: Handle __float128 type. * runtime/in_pack_generic.c (internal_pack): Ditto. * runtime/in_unpack_generic.c (internal_unpack): Ditto. * kinds-override.h: New file. * libgfortran.spec.in: Ditto. * generated/pow_r16_i4.c: Generated. * Makefile.in: Regenerate. * configure: Regenerate. * config.h: Regenerate. * bessel_r10.c: Regenerate. * bessel_r16.c: Regenerate. * bessel_r4.c: Regenerate. * bessel_r8.c: Regenerate. * exponent_r16.c: Regenerate. * fraction_r16.c: Regenerate. * nearest_r16.c: Regenerate. * norm2_r10.c: Regenerate. * norm2_r16.c: Regenerate. * norm2_r4.c: Regenerate. * norm2_r8.c: Regenerate. * rrspacing_r16.c: Regenerate. * set_exponent_r16.c: Regenerate. * spacing_r16.c: Regenerate. Co-Authored-By: Tobias Burnus <burnus@net-b.de> From-SVN: r166825
211 lines
3.9 KiB
C
211 lines
3.9 KiB
C
#include "quadmath-imp.h"
|
|
|
|
|
|
#define REALPART(z) (__real__(z))
|
|
#define IMAGPART(z) (__imag__(z))
|
|
#define COMPLEX_ASSIGN(z_, r_, i_) {__real__(z_) = (r_); __imag__(z_) = (i_);}
|
|
|
|
|
|
// Horrible... GCC doesn't know how to multiply or divide these
|
|
// __complex128 things. We have to do it on our own.
|
|
// Protect it around macros so, some day, we can switch it on
|
|
|
|
#if 0
|
|
|
|
# define C128_MULT(x,y) ((x)*(y))
|
|
# define C128_DIV(x,y) ((x)/(y))
|
|
|
|
#else
|
|
|
|
#define C128_MULT(x,y) mult_c128(x,y)
|
|
#define C128_DIV(x,y) div_c128(x,y)
|
|
|
|
static inline __complex128 mult_c128 (__complex128 x, __complex128 y)
|
|
{
|
|
__float128 r1 = REALPART(x), i1 = IMAGPART(x);
|
|
__float128 r2 = REALPART(y), i2 = IMAGPART(y);
|
|
__complex128 res;
|
|
COMPLEX_ASSIGN(res, r1*r2 - i1*i2, i2*r1 + i1*r2);
|
|
return res;
|
|
}
|
|
|
|
|
|
// Careful: the algorithm for the division sucks. A lot.
|
|
static inline __complex128 div_c128 (__complex128 x, __complex128 y)
|
|
{
|
|
__float128 n = hypotq (REALPART (y), IMAGPART (y));
|
|
__float128 r1 = REALPART(x), i1 = IMAGPART(x);
|
|
__float128 r2 = REALPART(y), i2 = IMAGPART(y);
|
|
__complex128 res;
|
|
COMPLEX_ASSIGN(res, r1*r2 + i1*i2, i1*r2 - i2*r1);
|
|
return res / n;
|
|
}
|
|
|
|
#endif
|
|
|
|
|
|
|
|
__float128
|
|
cabsq (__complex128 z)
|
|
{
|
|
return hypotq (REALPART (z), IMAGPART (z));
|
|
}
|
|
|
|
|
|
__complex128
|
|
cexpq (__complex128 z)
|
|
{
|
|
__float128 a, b;
|
|
__complex128 v;
|
|
|
|
a = REALPART (z);
|
|
b = IMAGPART (z);
|
|
COMPLEX_ASSIGN (v, cosq (b), sinq (b));
|
|
return expq (a) * v;
|
|
}
|
|
|
|
|
|
__complex128
|
|
cexpiq (__float128 x)
|
|
{
|
|
__complex128 v;
|
|
COMPLEX_ASSIGN (v, cosq (x), sinq (x));
|
|
return v;
|
|
}
|
|
|
|
|
|
__float128
|
|
cargq (__complex128 z)
|
|
{
|
|
return atan2q (IMAGPART (z), REALPART (z));
|
|
}
|
|
|
|
|
|
__complex128
|
|
clogq (__complex128 z)
|
|
{
|
|
__complex128 v;
|
|
COMPLEX_ASSIGN (v, logq (cabsq (z)), cargq (z));
|
|
return v;
|
|
}
|
|
|
|
|
|
__complex128
|
|
clog10q (__complex128 z)
|
|
{
|
|
__complex128 v;
|
|
COMPLEX_ASSIGN (v, log10q (cabsq (z)), cargq (z));
|
|
return v;
|
|
}
|
|
|
|
|
|
__complex128
|
|
cpowq (__complex128 base, __complex128 power)
|
|
{
|
|
return cexpq (C128_MULT(power, clogq (base)));
|
|
}
|
|
|
|
|
|
__complex128
|
|
csinq (__complex128 a)
|
|
{
|
|
__float128 r = REALPART (a), i = IMAGPART (a);
|
|
__complex128 v;
|
|
COMPLEX_ASSIGN (v, sinq (r) * coshq (i), cosq (r) * sinhq (i));
|
|
return v;
|
|
}
|
|
|
|
|
|
__complex128
|
|
csinhq (__complex128 a)
|
|
{
|
|
__float128 r = REALPART (a), i = IMAGPART (a);
|
|
__complex128 v;
|
|
COMPLEX_ASSIGN (v, sinhq (r) * cosq (i), coshq (r) * sinq (i));
|
|
return v;
|
|
}
|
|
|
|
|
|
__complex128
|
|
ccosq (__complex128 a)
|
|
{
|
|
__float128 r = REALPART (a), i = IMAGPART (a);
|
|
__complex128 v;
|
|
COMPLEX_ASSIGN (v, cosq (r) * coshq (i), - (sinq (r) * sinhq (i)));
|
|
return v;
|
|
}
|
|
|
|
|
|
__complex128
|
|
ccoshq (__complex128 a)
|
|
{
|
|
__float128 r = REALPART (a), i = IMAGPART (a);
|
|
__complex128 v;
|
|
COMPLEX_ASSIGN (v, coshq (r) * cosq (i), sinhq (r) * sinq (i));
|
|
return v;
|
|
}
|
|
|
|
|
|
__complex128
|
|
ctanq (__complex128 a)
|
|
{
|
|
__float128 rt = tanq (REALPART (a)), it = tanhq (IMAGPART (a));
|
|
__complex128 n, d;
|
|
COMPLEX_ASSIGN (n, rt, it);
|
|
COMPLEX_ASSIGN (d, 1, - (rt * it));
|
|
return C128_DIV(n,d);
|
|
}
|
|
|
|
|
|
__complex128
|
|
ctanhq (__complex128 a)
|
|
{
|
|
__float128 rt = tanhq (REALPART (a)), it = tanq (IMAGPART (a));
|
|
__complex128 n, d;
|
|
COMPLEX_ASSIGN (n, rt, it);
|
|
COMPLEX_ASSIGN (d, 1, rt * it);
|
|
return C128_DIV(n,d);
|
|
}
|
|
|
|
|
|
/* Square root algorithm from glibc. */
|
|
__complex128
|
|
csqrtq (__complex128 z)
|
|
{
|
|
__float128 re = REALPART(z), im = IMAGPART(z);
|
|
__complex128 v;
|
|
|
|
if (im == 0)
|
|
{
|
|
if (re < 0)
|
|
{
|
|
COMPLEX_ASSIGN (v, 0, copysignq (sqrtq (-re), im));
|
|
}
|
|
else
|
|
{
|
|
COMPLEX_ASSIGN (v, fabsq (sqrtq (re)), copysignq (0, im));
|
|
}
|
|
}
|
|
else if (re == 0)
|
|
{
|
|
__float128 r = sqrtq (0.5 * fabsq (im));
|
|
COMPLEX_ASSIGN (v, r, copysignq (r, im));
|
|
}
|
|
else
|
|
{
|
|
__float128 d = hypotq (re, im);
|
|
__float128 r, s;
|
|
|
|
/* Use the identity 2 Re res Im res = Im x
|
|
to avoid cancellation error in d +/- Re x. */
|
|
if (re > 0)
|
|
r = sqrtq (0.5 * d + 0.5 * re), s = (0.5 * im) / r;
|
|
else
|
|
s = sqrtq (0.5 * d - 0.5 * re), r = fabsq ((0.5 * im) / s);
|
|
|
|
COMPLEX_ASSIGN (v, r, copysignq (s, im));
|
|
}
|
|
return v;
|
|
}
|
|
|