diff options
Diffstat (limited to 'usr/src/lib/libm/common/complex')
73 files changed, 9895 insertions, 0 deletions
diff --git a/usr/src/lib/libm/common/complex/cabs.c b/usr/src/lib/libm/common/complex/cabs.c new file mode 100644 index 0000000000..a41233347e --- /dev/null +++ b/usr/src/lib/libm/common/complex/cabs.c @@ -0,0 +1,183 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2005 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cabs = __cabs + +#include "libm_synonyms.h" +#include <math.h> +#include "complex_wrapper.h" + +/* + * If C were the only standard we cared about, cabs could just call + * hypot. Unfortunately, various other standards say that hypot must + * call matherr and/or set errno to ERANGE when the result overflows. + * Since cabs should do neither of these things, we have to either + * make hypot a wrapper on another internal function or duplicate + * the hypot implementation here. I've chosen to do the latter. + */ + +static const double + zero = 0.0, + onep1u = 1.00000000000000022204e+00, /* 0x3ff00000 1 = 1+2**-52 */ + twom53 = 1.11022302462515654042e-16, /* 0x3ca00000 0 = 2**-53 */ + twom768 = 6.441148769597133308e-232, /* 2^-768 */ + two768 = 1.552518092300708935e+231; /* 2^768 */ + +double +cabs(dcomplex z) +{ + double x, y, xh, yh, w, ax, ay; + int i, j, nx, ny, ix, iy, iscale = 0; + unsigned lx, ly; + + x = D_RE(z); + y = D_IM(z); + + ix = ((int *)&x)[HIWORD] & ~0x80000000; + lx = ((int *)&x)[LOWORD]; + iy = ((int *)&y)[HIWORD] & ~0x80000000; + ly = ((int *)&y)[LOWORD]; + + /* force ax = |x| ~>~ ay = |y| */ + if (iy > ix) { + ax = fabs(y); + ay = fabs(x); + i = ix; + ix = iy; + iy = i; + i = lx; + lx = ly; + ly = i; + } else { + ax = fabs(x); + ay = fabs(y); + } + nx = ix >> 20; + ny = iy >> 20; + j = nx - ny; + + if (nx >= 0x5f3) { + /* x >= 2^500 (x*x or y*y may overflow) */ + if (nx == 0x7ff) { + /* inf or NaN, signal of sNaN */ + if (((ix - 0x7ff00000) | lx) == 0) + return ((ax == ay)? ay : ax); + else if (((iy - 0x7ff00000) | ly) == 0) + return ((ay == ax)? ax : ay); + else + return (ax * ay); + } else if (j > 32) { + /* x >> y */ + if (j <= 53) + ay *= twom53; + ax += ay; + return (ax); + } + ax *= twom768; + ay *= twom768; + iscale = 2; + ix -= 768 << 20; + iy -= 768 << 20; + } else if (ny < 0x23d) { + /* y < 2^-450 (x*x or y*y may underflow) */ + if ((ix | lx) == 0) + return (ay); + if ((iy | ly) == 0) + return (ax); + if (j > 53) /* x >> y */ + return (ax + ay); + iscale = 1; + ax *= two768; + ay *= two768; + if (nx == 0) { + if (ax == zero) /* guard subnormal flush to zero */ + return (ax); + ix = ((int *)&ax)[HIWORD]; + } else { + ix += 768 << 20; + } + if (ny == 0) { + if (ay == zero) /* guard subnormal flush to zero */ + return (ax * twom768); + iy = ((int *)&ay)[HIWORD]; + } else { + iy += 768 << 20; + } + j = (ix >> 20) - (iy >> 20); + if (j > 32) { + /* x >> y */ + if (j <= 53) + ay *= twom53; + return ((ax + ay) * twom768); + } + } else if (j > 32) { + /* x >> y */ + if (j <= 53) + ay *= twom53; + return (ax + ay); + } + + /* + * Medium range ax and ay with max{|ax/ay|,|ay/ax|} bounded by 2^32. + * First check rounding mode by comparing onep1u*onep1u with onep1u + * + twom53. Make sure the computation is done at run-time. + */ + if (((lx | ly) << 5) == 0) { + ay = ay * ay; + ax += ay / (ax + sqrt(ax * ax + ay)); + } else if (onep1u * onep1u != onep1u + twom53) { + /* round-to-zero, positive, negative mode */ + /* magic formula with less than an ulp error */ + w = sqrt(ax * ax + ay * ay); + ax += ay / ((ax + w) / ay); + } else { + /* round-to-nearest mode */ + w = ax - ay; + if (w > ay) { + ((int *)&xh)[HIWORD] = ix; + ((int *)&xh)[LOWORD] = 0; + ay = ay * ay + (ax - xh) * (ax + xh); + ax = sqrt(xh * xh + ay); + } else { + ax = ax + ax; + ((int *)&xh)[HIWORD] = ix + 0x00100000; + ((int *)&xh)[LOWORD] = 0; + ((int *)&yh)[HIWORD] = iy; + ((int *)&yh)[LOWORD] = 0; + ay = w * w + ((ax - xh) * yh + (ay - yh) * ax); + ax = sqrt(xh * yh + ay); + } + } + if (iscale > 0) { + if (iscale == 1) + ax *= twom768; + else + ax *= two768; /* must generate side effect here */ + } + return (ax); +} diff --git a/usr/src/lib/libm/common/complex/cabsf.c b/usr/src/lib/libm/common/complex/cabsf.c new file mode 100644 index 0000000000..a9f61027fb --- /dev/null +++ b/usr/src/lib/libm/common/complex/cabsf.c @@ -0,0 +1,38 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cabsf = __cabsf + +#include "libm.h" +#include "complex_wrapper.h" + +float +cabsf(fcomplex z) { + return (hypotf(F_RE(z), F_IM(z))); +} diff --git a/usr/src/lib/libm/common/complex/cabsl.c b/usr/src/lib/libm/common/complex/cabsl.c new file mode 100644 index 0000000000..10b029f95c --- /dev/null +++ b/usr/src/lib/libm/common/complex/cabsl.c @@ -0,0 +1,38 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cabsl = __cabsl + +#include "libm.h" +#include "complex_wrapper.h" + +long double +cabsl(ldcomplex z) { + return (hypotl(LD_RE(z), LD_IM(z))); +} diff --git a/usr/src/lib/libm/common/complex/cacos.c b/usr/src/lib/libm/common/complex/cacos.c new file mode 100644 index 0000000000..4fccae23bb --- /dev/null +++ b/usr/src/lib/libm/common/complex/cacos.c @@ -0,0 +1,404 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cacos = __cacos + +/* INDENT OFF */ +/* + * dcomplex cacos(dcomplex z); + * + * Alogrithm + * (based on T.E.Hull, Thomas F. Fairgrieve and Ping Tak Peter Tang's + * paper "Implementing the Complex Arcsine and Arccosine Functins Using + * Exception Handling", ACM TOMS, Vol 23, pp 299-335) + * + * The principal value of complex inverse cosine function cacos(z), + * where z = x+iy, can be defined by + * + * cacos(z) = acos(B) - i sign(y) log (A + sqrt(A*A-1)), + * + * where the log function is the natural log, and + * ____________ ____________ + * 1 / 2 2 1 / 2 2 + * A = --- / (x+1) + y + --- / (x-1) + y + * 2 \/ 2 \/ + * ____________ ____________ + * 1 / 2 2 1 / 2 2 + * B = --- / (x+1) + y - --- / (x-1) + y . + * 2 \/ 2 \/ + * + * The Branch cuts are on the real line from -inf to -1 and from 1 to inf. + * The real and imaginary parts are based on Abramowitz and Stegun + * [Handbook of Mathematic Functions, 1972]. The sign of the imaginary + * part is chosen to be the generally considered the principal value of + * this function. + * + * Notes:1. A is the average of the distances from z to the points (1,0) + * and (-1,0) in the complex z-plane, and in particular A>=1. + * 2. B is in [-1,1], and A*B = x + * + * Basic relations + * cacos(conj(z)) = conj(cacos(z)) + * cacos(-z) = pi - cacos(z) + * cacos( z) = pi/2 - casin(z) + * + * Special cases (conform to ISO/IEC 9899:1999(E)): + * cacos(+-0 + i y ) = pi/2 - i y for y is +-0, +-inf, NaN + * cacos( x + i inf) = pi/2 - i inf for all x + * cacos( x + i NaN) = NaN + i NaN with invalid for non-zero finite x + * cacos(-inf + i y ) = pi - i inf for finite +y + * cacos( inf + i y ) = 0 - i inf for finite +y + * cacos(-inf + i inf) = 3pi/4- i inf + * cacos( inf + i inf) = pi/4 - i inf + * cacos(+-inf+ i NaN) = NaN - i inf (sign of imaginary is unspecified) + * cacos(NaN + i y ) = NaN + i NaN with invalid for finite y + * cacos(NaN + i inf) = NaN - i inf + * cacos(NaN + i NaN) = NaN + i NaN + * + * Special Regions (better formula for accuracy and for avoiding spurious + * overflow or underflow) (all x and y are assumed nonnegative): + * case 1: y = 0 + * case 2: tiny y relative to x-1: y <= ulp(0.5)*|x-1| + * case 3: tiny y: y < 4 sqrt(u), where u = minimum normal number + * case 4: huge y relative to x+1: y >= (1+x)/ulp(0.5) + * case 5: huge x and y: x and y >= sqrt(M)/8, where M = maximum normal number + * case 6: tiny x: x < 4 sqrt(u) + * -------- + * case 1 & 2. y=0 or y/|x-1| is tiny. We have + * ____________ _____________ + * / 2 2 / y 2 + * / (x+-1) + y = |x+-1| / 1 + (------) + * \/ \/ |x+-1| + * + * 1 y 2 + * ~ |x+-1| ( 1 + --- (------) ) + * 2 |x+-1| + * + * 2 + * y + * = |x+-1| + --------. + * 2|x+-1| + * + * Consequently, it is not difficult to see that + * 2 + * y + * [ 1 + ------------ , if x < 1, + * [ 2(1+x)(1-x) + * [ + * [ + * [ x, if x = 1 (y = 0), + * [ + * A ~= [ 2 + * [ x * y + * [ x + ------------ ~ x, if x > 1 + * [ 2(x+1)(x-1) + * + * and hence + * ______ 2 + * / 2 y y + * A + \/ A - 1 ~ 1 + ---------------- + -----------, if x < 1, + * sqrt((x+1)(1-x)) 2(x+1)(1-x) + * + * + * ~ x + sqrt((x-1)*(x+1)), if x >= 1. + * + * 2 + * y + * [ x(1 - -----------) ~ x, if x < 1, + * [ 2(1+x)(1-x) + * B = x/A ~ [ + * [ 1, if x = 1, + * [ + * [ 2 + * [ y + * [ 1 - ------------ , if x > 1, + * [ 2(x+1)(x-1) + * Thus + * [ acos(x) - i y/sqrt((x-1)*(x+1)), if x < 1, + * [ + * cacos(x+i*y)~ [ 0 - i 0, if x = 1, + * [ + * [ y/sqrt(x*x-1) - i log(x+sqrt(x*x-1)), if x > 1. + * + * Note: y/sqrt(x*x-1) ~ y/x when x >= 2**26. + * case 3. y < 4 sqrt(u), where u = minimum normal x. + * After case 1 and 2, this will only occurs when x=1. When x=1, we have + * A = (sqrt(4+y*y)+y)/2 ~ 1 + y/2 + y^2/8 + ... + * and + * B = 1/A = 1 - y/2 + y^2/8 + ... + * Since + * cos(sqrt(y)) ~ 1 - y/2 + ... + * we have, for the real part, + * acos(B) ~ acos(1 - y/2) ~ sqrt(y) + * For the imaginary part, + * log(A+sqrt(A*A-1)) ~ log(1+y/2+sqrt(2*y/2)) + * = log(1+y/2+sqrt(y)) + * = (y/2+sqrt(y)) - (y/2+sqrt(y))^2/2 + ... + * ~ sqrt(y) - y*(sqrt(y)+y/2)/2 + * ~ sqrt(y) + * + * case 4. y >= (x+1)/ulp(0.5). In this case, A ~ y and B ~ x/y. Thus + * real part = acos(B) ~ pi/2 + * and + * imag part = log(y+sqrt(y*y-one)) + * + * case 5. Both x and y are large: x and y > sqrt(M)/8, where M = maximum x + * In this case, + * A ~ sqrt(x*x+y*y) + * B ~ x/sqrt(x*x+y*y). + * Thus + * real part = acos(B) = atan(y/x), + * imag part = log(A+sqrt(A*A-1)) ~ log(2A) + * = log(2) + 0.5*log(x*x+y*y) + * = log(2) + log(y) + 0.5*log(1+(x/y)^2) + * + * case 6. x < 4 sqrt(u). In this case, we have + * A ~ sqrt(1+y*y), B = x/sqrt(1+y*y). + * Since B is tiny, we have + * real part = acos(B) ~ pi/2 + * imag part = log(A+sqrt(A*A-1)) = log (A+sqrt(y*y)) + * = log(y+sqrt(1+y*y)) + * = 0.5*log(y^2+2ysqrt(1+y^2)+1+y^2) + * = 0.5*log(1+2y(y+sqrt(1+y^2))); + * = 0.5*log1p(2y(y+A)); + * + * cacos(z) = acos(B) - i sign(y) log (A + sqrt(A*A-1)), + */ +/* INDENT ON */ + +#include "libm.h" +#include "complex_wrapper.h" + +/* INDENT OFF */ +static const double + zero = 0.0, + one = 1.0, + E = 1.11022302462515654042e-16, /* 2**-53 */ + ln2 = 6.93147180559945286227e-01, + pi = 3.1415926535897931159979634685, + pi_l = 1.224646799147353177e-16, + pi_2 = 1.570796326794896558e+00, + pi_2_l = 6.123233995736765886e-17, + pi_4 = 0.78539816339744827899949, + pi_4_l = 3.061616997868382943e-17, + pi3_4 = 2.356194490192344836998, + pi3_4_l = 9.184850993605148829195e-17, + Foursqrtu = 5.96667258496016539463e-154, /* 2**(-509) */ + Acrossover = 1.5, + Bcrossover = 0.6417, + half = 0.5; +/* INDENT ON */ + +dcomplex +cacos(dcomplex z) { + double x, y, t, R, S, A, Am1, B, y2, xm1, xp1, Apx; + int ix, iy, hx, hy; + unsigned lx, ly; + dcomplex ans; + + x = D_RE(z); + y = D_IM(z); + hx = HI_WORD(x); + lx = LO_WORD(x); + hy = HI_WORD(y); + ly = LO_WORD(y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + + /* x is 0 */ + if ((ix | lx) == 0) { + if (((iy | ly) == 0) || (iy >= 0x7ff00000)) { + D_RE(ans) = pi_2; + D_IM(ans) = -y; + return (ans); + } + } + + /* |y| is inf or NaN */ + if (iy >= 0x7ff00000) { + if (ISINF(iy, ly)) { /* cacos(x + i inf) = pi/2 - i inf */ + D_IM(ans) = -y; + if (ix < 0x7ff00000) { + D_RE(ans) = pi_2 + pi_2_l; + } else if (ISINF(ix, lx)) { + if (hx >= 0) + D_RE(ans) = pi_4 + pi_4_l; + else + D_RE(ans) = pi3_4 + pi3_4_l; + } else { + D_RE(ans) = x; + } + } else { /* cacos(x + i NaN) = NaN + i NaN */ + D_RE(ans) = y + x; + if (ISINF(ix, lx)) + D_IM(ans) = -fabs(x); + else + D_IM(ans) = y; + } + return (ans); + } + + x = fabs(x); + y = fabs(y); + + /* x is inf or NaN */ + if (ix >= 0x7ff00000) { /* x is inf or NaN */ + if (ISINF(ix, lx)) { /* x is INF */ + D_IM(ans) = -x; + if (iy >= 0x7ff00000) { + if (ISINF(iy, ly)) { + /* INDENT OFF */ + /* cacos(inf + i inf) = pi/4 - i inf */ + /* cacos(-inf+ i inf) =3pi/4 - i inf */ + /* INDENT ON */ + if (hx >= 0) + D_RE(ans) = pi_4 + pi_4_l; + else + D_RE(ans) = pi3_4 + pi3_4_l; + } else + /* INDENT OFF */ + /* cacos(inf + i NaN) = NaN - i inf */ + /* INDENT ON */ + D_RE(ans) = y + y; + } else + /* INDENT OFF */ + /* cacos(inf + iy ) = 0 - i inf */ + /* cacos(-inf+ iy ) = pi - i inf */ + /* INDENT ON */ + if (hx >= 0) + D_RE(ans) = zero; + else + D_RE(ans) = pi + pi_l; + } else { /* x is NaN */ + /* INDENT OFF */ + /* + * cacos(NaN + i inf) = NaN - i inf + * cacos(NaN + i y ) = NaN + i NaN + * cacos(NaN + i NaN) = NaN + i NaN + */ + /* INDENT ON */ + D_RE(ans) = x + y; + if (iy >= 0x7ff00000) { + D_IM(ans) = -y; + } else { + D_IM(ans) = x; + } + } + if (hy < 0) + D_IM(ans) = -D_IM(ans); + return (ans); + } + + if ((iy | ly) == 0) { /* region 1: y=0 */ + if (ix < 0x3ff00000) { /* |x| < 1 */ + D_RE(ans) = acos(x); + D_IM(ans) = zero; + } else { + D_RE(ans) = zero; + if (ix >= 0x43500000) /* |x| >= 2**54 */ + D_IM(ans) = ln2 + log(x); + else if (ix >= 0x3ff80000) /* x > Acrossover */ + D_IM(ans) = log(x + sqrt((x - one) * (x + + one))); + else { + xm1 = x - one; + D_IM(ans) = log1p(xm1 + sqrt(xm1 * (x + one))); + } + } + } else if (y <= E * fabs(x - one)) { /* region 2: y < tiny*|x-1| */ + if (ix < 0x3ff00000) { /* x < 1 */ + D_RE(ans) = acos(x); + D_IM(ans) = y / sqrt((one + x) * (one - x)); + } else if (ix >= 0x43500000) { /* |x| >= 2**54 */ + D_RE(ans) = y / x; + D_IM(ans) = ln2 + log(x); + } else { + t = sqrt((x - one) * (x + one)); + D_RE(ans) = y / t; + if (ix >= 0x3ff80000) /* x > Acrossover */ + D_IM(ans) = log(x + t); + else + D_IM(ans) = log1p((x - one) + t); + } + } else if (y < Foursqrtu) { /* region 3 */ + t = sqrt(y); + D_RE(ans) = t; + D_IM(ans) = t; + } else if (E * y - one >= x) { /* region 4 */ + D_RE(ans) = pi_2; + D_IM(ans) = ln2 + log(y); + } else if (ix >= 0x5fc00000 || iy >= 0x5fc00000) { /* x,y>2**509 */ + /* region 5: x+1 or y is very large (>= sqrt(max)/8) */ + t = x / y; + D_RE(ans) = atan(y / x); + D_IM(ans) = ln2 + log(y) + half * log1p(t * t); + } else if (x < Foursqrtu) { + /* region 6: x is very small, < 4sqrt(min) */ + D_RE(ans) = pi_2; + A = sqrt(one + y * y); + if (iy >= 0x3ff80000) /* if y > Acrossover */ + D_IM(ans) = log(y + A); + else + D_IM(ans) = half * log1p((y + y) * (y + A)); + } else { /* safe region */ + y2 = y * y; + xp1 = x + one; + xm1 = x - one; + R = sqrt(xp1 * xp1 + y2); + S = sqrt(xm1 * xm1 + y2); + A = half * (R + S); + B = x / A; + if (B <= Bcrossover) + D_RE(ans) = acos(B); + else { /* use atan and an accurate approx to a-x */ + Apx = A + x; + if (x <= one) + D_RE(ans) = atan(sqrt(half * Apx * (y2 / (R + + xp1) + (S - xm1))) / x); + else + D_RE(ans) = atan((y * sqrt(half * (Apx / (R + + xp1) + Apx / (S + xm1)))) / x); + } + if (A <= Acrossover) { + /* use log1p and an accurate approx to A-1 */ + if (x < one) + Am1 = half * (y2 / (R + xp1) + y2 / (S - xm1)); + else + Am1 = half * (y2 / (R + xp1) + (S + xm1)); + D_IM(ans) = log1p(Am1 + sqrt(Am1 * (A + one))); + } else { + D_IM(ans) = log(A + sqrt(A * A - one)); + } + } + if (hx < 0) + D_RE(ans) = pi - D_RE(ans); + if (hy >= 0) + D_IM(ans) = -D_IM(ans); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/cacosf.c b/usr/src/lib/libm/common/complex/cacosf.c new file mode 100644 index 0000000000..b693a44c05 --- /dev/null +++ b/usr/src/lib/libm/common/complex/cacosf.c @@ -0,0 +1,46 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cacosf = __cacosf + +#include "libm.h" +#include "complex_wrapper.h" + +fcomplex +cacosf(fcomplex z) { + dcomplex dz, dans; + fcomplex ans; + + D_RE(dz) = (double) (F_RE(z)); + D_IM(dz) = (double) (F_IM(z)); + dans = cacos(dz); + F_RE(ans) = (float) (D_RE(dans)); + F_IM(ans) = (float) (D_IM(dans)); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/cacosh.c b/usr/src/lib/libm/common/complex/cacosh.c new file mode 100644 index 0000000000..6c6ffe612e --- /dev/null +++ b/usr/src/lib/libm/common/complex/cacosh.c @@ -0,0 +1,70 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cacosh = __cacosh + +/* INDENT OFF */ +/* + * dcomplex cacosh(dcomplex z); + * cacosh z = +-i cacos z . + * In order to make conj(cacosh(z))=cacosh(conj(z)), + * we define + * cacosh z = sign(Im(z))*i cacos z . + * + */ +/* INDENT ON */ + +#include "libm.h" /* fabs/isnan/isinf/signbit */ +#include "complex_wrapper.h" + +/* need to work on special cases according to spec */ + +dcomplex +cacosh(dcomplex z) { + dcomplex w, ans; + double x, y; + + w = cacos(z); + x = D_RE(z); + y = D_IM(z); + if (isnan(y)) { + D_IM(ans) = y + y; + if (isinf(x)) + D_RE(ans) = fabs(x); + else + D_RE(ans) = y; + } else if (signbit(y) == 0) { + D_RE(ans) = -D_IM(w); + D_IM(ans) = D_RE(w); + } else { + D_RE(ans) = D_IM(w); + D_IM(ans) = -D_RE(w); + } + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/cacoshf.c b/usr/src/lib/libm/common/complex/cacoshf.c new file mode 100644 index 0000000000..8feaf735e6 --- /dev/null +++ b/usr/src/lib/libm/common/complex/cacoshf.c @@ -0,0 +1,48 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cacoshf = __cacoshf + +#include "libm.h" +#include "complex_wrapper.h" + +/* need to work on special cases according to spec */ + +fcomplex +cacoshf(fcomplex z) { + dcomplex dz, dans; + fcomplex ans; + + D_RE(dz) = (double) (F_RE(z)); + D_IM(dz) = (double) (F_IM(z)); + dans = cacosh(dz); + F_RE(ans) = (float) (D_RE(dans)); + F_IM(ans) = (float) (D_IM(dans)); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/cacoshl.c b/usr/src/lib/libm/common/complex/cacoshl.c new file mode 100644 index 0000000000..1e17db3f2e --- /dev/null +++ b/usr/src/lib/libm/common/complex/cacoshl.c @@ -0,0 +1,69 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cacoshl = __cacoshl + +#include "libm.h" /* fabsl/isnanl/isinfl/signbitl */ +#include "complex_wrapper.h" +#include "longdouble.h" + +/* INDENT OFF */ +/* + * ldcomplex cacoshl(ldcomplex z); + * cacosh z = +-i cacos z . + * In order to make conj(cacosh(z))=cacosh(conj(z)), + * we define + * cacosh z = sign(Im(z))*i cacos z . + * + */ +/* INDENT ON */ + +ldcomplex +cacoshl(ldcomplex z) { + ldcomplex w, ans; + long double x, y; + + w = cacosl(z); + x = LD_RE(z); + y = LD_IM(z); + if (isnanl(y)) { + LD_IM(ans) = y + y; + if (isinfl(x)) + LD_RE(ans) = fabsl(x); + else + LD_RE(ans) = y; + } else if (signbitl(y) == 0) { + LD_RE(ans) = -LD_IM(w); + LD_IM(ans) = LD_RE(w); + } else { + LD_RE(ans) = LD_IM(w); + LD_IM(ans) = -LD_RE(w); + } + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/cacosl.c b/usr/src/lib/libm/common/complex/cacosl.c new file mode 100644 index 0000000000..a10f9801dd --- /dev/null +++ b/usr/src/lib/libm/common/complex/cacosl.c @@ -0,0 +1,272 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cacosl = __cacosl + +#include "libm.h" /* acosl/atanl/fabsl/isinfl/log1pl/logl/sqrtl */ +#include "complex_wrapper.h" +#include "longdouble.h" + +/* INDENT OFF */ +static const long double +zero = 0.0L, +one = 1.0L, +Acrossover = 1.5L, +Bcrossover = 0.6417L, +half = 0.5L, +ln2 = 6.931471805599453094172321214581765680755e-0001L, +Foursqrtu = 7.3344154702193886624856495681939326638255e-2466L, /* 2**-8189 */ +#if defined(__x86) +E = 5.4210108624275221700372640043497085571289e-20L, /* 2**-64 */ +pi = 3.141592653589793238295968524909085317631252110004425048828125L, +pi_l = 1.666748583704175665659172893706807721468195923078e-19L, +pi_2 = 1.5707963267948966191479842624545426588156260L, +pi_2_l = 8.3337429185208783282958644685340386073409796e-20L, +pi_4 = 0.78539816339744830957399213122727132940781302750110626220703125L, +pi_4_l = 4.166871459260439164147932234267019303670489807695410e-20L, +pi3_4 = 2.35619449019234492872197639368181398822343908250331878662109375L, +pi3_4_l = 1.250061437778131749244379670280105791101146942308e-19L; +#else +E = 9.6296497219361792652798897129246365926905e-35L, /* 2**-113 */ +pi = 3.1415926535897932384626433832795027974790680981372955730045043318L, +pi_l = 8.6718101301237810247970440260433519687623233462565303417759356862e-35L, +pi_2 = 1.5707963267948966192313216916397513987395340L, +pi_2_l = 4.3359050650618905123985220130216759843811616e-35L, +pi_4 = 0.785398163397448309615660845819875699369767024534323893251126L, +pi_4_l = 2.167952532530945256199261006510837992190580836564132585443e-35L, +pi3_4 = 2.35619449019234492884698253745962709810930107360297167975337824L, +pi3_4_l = 6.503857597592835768597783019532513976571742509692397756331e-35L; +#endif +/* INDENT ON */ + +#if defined(__x86) +static const int ip1 = 0x40400000; /* 2**65 */ +#else +static const int ip1 = 0x40710000; /* 2**114 */ +#endif + +ldcomplex +cacosl(ldcomplex z) { + long double x, y, t, R, S, A, Am1, B, y2, xm1, xp1, Apx; + int ix, iy, hx, hy; + ldcomplex ans; + + x = LD_RE(z); + y = LD_IM(z); + hx = HI_XWORD(x); + hy = HI_XWORD(y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + + /* x is 0 */ + if (x == zero) { + if (y == zero || (iy >= 0x7fff0000)) { + LD_RE(ans) = pi_2 + pi_2_l; + LD_IM(ans) = -y; + return (ans); + } + } + + /* |y| is inf or NaN */ + if (iy >= 0x7fff0000) { + if (isinfl(y)) { /* cacos(x + i inf) = pi/2 - i inf */ + LD_IM(ans) = -y; + if (ix < 0x7fff0000) { + LD_RE(ans) = pi_2 + pi_2_l; + } else if (isinfl(x)) { + if (hx >= 0) + LD_RE(ans) = pi_4 + pi_4_l; + else + LD_RE(ans) = pi3_4 + pi3_4_l; + } else { + LD_RE(ans) = x; + } + } else { /* cacos(x + i NaN) = NaN + i NaN */ + LD_RE(ans) = y + x; + if (isinfl(x)) + LD_IM(ans) = -fabsl(x); + else + LD_IM(ans) = y; + } + return (ans); + } + + y = fabsl(y); + + if (ix >= 0x7fff0000) { /* x is inf or NaN */ + if (isinfl(x)) { /* x is INF */ + LD_IM(ans) = -fabsl(x); + if (iy >= 0x7fff0000) { + if (isinfl(y)) { + /* INDENT OFF */ + /* cacos(inf + i inf) = pi/4 - i inf */ + /* cacos(-inf+ i inf) =3pi/4 - i inf */ + /* INDENT ON */ + if (hx >= 0) + LD_RE(ans) = pi_4 + pi_4_l; + else + LD_RE(ans) = pi3_4 + pi3_4_l; + } else + /* INDENT OFF */ + /* cacos(inf + i NaN) = NaN - i inf */ + /* INDENT ON */ + LD_RE(ans) = y + y; + } else { + /* INDENT OFF */ + /* cacos(inf + iy ) = 0 - i inf */ + /* cacos(-inf+ iy ) = pi - i inf */ + /* INDENT ON */ + if (hx >= 0) + LD_RE(ans) = zero; + else + LD_RE(ans) = pi + pi_l; + } + } else { /* x is NaN */ + /* INDENT OFF */ + /* + * cacos(NaN + i inf) = NaN - i inf + * cacos(NaN + i y ) = NaN + i NaN + * cacos(NaN + i NaN) = NaN + i NaN + */ + /* INDENT ON */ + LD_RE(ans) = x + y; + if (iy >= 0x7fff0000) { + LD_IM(ans) = -y; + } else { + LD_IM(ans) = x; + } + } + if (hy < 0) + LD_IM(ans) = -LD_IM(ans); + return (ans); + } + + if (y == zero) { /* region 1: y=0 */ + if (ix < 0x3fff0000) { /* |x| < 1 */ + LD_RE(ans) = acosl(x); + LD_IM(ans) = zero; + } else { + LD_RE(ans) = zero; + x = fabsl(x); + if (ix >= ip1) /* i386 ? 2**65 : 2**114 */ + LD_IM(ans) = ln2 + logl(x); + else if (ix >= 0x3fff8000) /* x > Acrossover */ + LD_IM(ans) = logl(x + sqrtl((x - one) * (x + + one))); + else { + xm1 = x - one; + LD_IM(ans) = log1pl(xm1 + sqrtl(xm1 * (x + + one))); + } + } + } else if (y <= E * fabsl(fabsl(x) - one)) { + /* region 2: y < tiny*||x|-1| */ + if (ix < 0x3fff0000) { /* x < 1 */ + LD_RE(ans) = acosl(x); + x = fabsl(x); + LD_IM(ans) = y / sqrtl((one + x) * (one - x)); + } else if (ix >= ip1) { /* i386 ? 2**65 : 2**114 */ + if (hx >= 0) + LD_RE(ans) = y / x; + else { + if (ix >= ip1 + 0x00040000) + LD_RE(ans) = pi + pi_l; + else { + t = pi_l + y / x; + LD_RE(ans) = pi + t; + } + } + LD_IM(ans) = ln2 + logl(fabsl(x)); + } else { + x = fabsl(x); + t = sqrtl((x - one) * (x + one)); + LD_RE(ans) = (hx >= 0)? y / t : pi - (y / t - pi_l); + if (ix >= 0x3fff8000) /* x > Acrossover */ + LD_IM(ans) = logl(x + t); + else + LD_IM(ans) = log1pl(t - (one - x)); + } + } else if (y < Foursqrtu) { /* region 3 */ + t = sqrtl(y); + LD_RE(ans) = (hx >= 0)? t : pi + pi_l; + LD_IM(ans) = t; + } else if (E * y - one >= fabsl(x)) { /* region 4 */ + LD_RE(ans) = pi_2 + pi_2_l; + LD_IM(ans) = ln2 + logl(y); + } else if (ix >= 0x5ffb0000 || iy >= 0x5ffb0000) { + /* region 5: x+1 and y are both (>= sqrt(max)/8) i.e. 2**8188 */ + t = x / y; + LD_RE(ans) = atan2l(y, x); + LD_IM(ans) = ln2 + logl(y) + half * log1pl(t * t); + } else if (fabsl(x) < Foursqrtu) { + /* region 6: x is very small, < 4sqrt(min) */ + LD_RE(ans) = pi_2 + pi_2_l; + A = sqrtl(one + y * y); + if (iy >= 0x3fff8000) /* if y > Acrossover */ + LD_IM(ans) = logl(y + A); + else + LD_IM(ans) = half * log1pl((y + y) * (y + A)); + } else { /* safe region */ + t = fabsl(x); + y2 = y * y; + xp1 = t + one; + xm1 = t - one; + R = sqrtl(xp1 * xp1 + y2); + S = sqrtl(xm1 * xm1 + y2); + A = half * (R + S); + B = t / A; + + if (B <= Bcrossover) + LD_RE(ans) = (hx >= 0)? acosl(B) : acosl(-B); + else { /* use atan and an accurate approx to a-x */ + Apx = A + t; + if (t <= one) + LD_RE(ans) = atan2l(sqrtl(half * Apx * (y2 / + (R + xp1) + (S - xm1))), x); + else + LD_RE(ans) = atan2l((y * sqrtl(half * (Apx / + (R + xp1) + Apx / (S + xm1)))), x); + } + if (A <= Acrossover) { + /* use log1p and an accurate approx to A-1 */ + if (ix < 0x3fff0000) + Am1 = half * (y2 / (R + xp1) + y2 / (S - xm1)); + else + Am1 = half * (y2 / (R + xp1) + (S + xm1)); + LD_IM(ans) = log1pl(Am1 + sqrtl(Am1 * (A + one))); + } else { + LD_IM(ans) = logl(A + sqrtl(A * A - one)); + } + } + + if (hy >= 0) + LD_IM(ans) = -LD_IM(ans); + + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/carg.c b/usr/src/lib/libm/common/complex/carg.c new file mode 100644 index 0000000000..a79bca005b --- /dev/null +++ b/usr/src/lib/libm/common/complex/carg.c @@ -0,0 +1,53 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2005 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak carg = __carg + +#include "libm_synonyms.h" +#include <math.h> /* atan2 */ +#include "complex_wrapper.h" + +static const double + pi = 3.14159265358979311600e+00, + pi_lo = 1.22464679914735320717e-16; + +double +carg(dcomplex z) { + int ix, iy; + + ix = ((int *)&(D_RE(z)))[HIWORD]; + iy = ((int *)&(D_IM(z)))[HIWORD]; + if ((((ix | iy) & ~0x80000000) | ((int *)&(D_RE(z)))[LOWORD] | + ((int *)&(D_IM(z)))[LOWORD]) == 0) { + /* x and y are both zero */ + if (ix == 0) + return (D_IM(z)); + return ((iy == 0)? pi + pi_lo : -pi - pi_lo); + } + return (atan2(D_IM(z), D_RE(z))); +} diff --git a/usr/src/lib/libm/common/complex/cargf.c b/usr/src/lib/libm/common/complex/cargf.c new file mode 100644 index 0000000000..30e25aafac --- /dev/null +++ b/usr/src/lib/libm/common/complex/cargf.c @@ -0,0 +1,38 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cargf = __cargf + +#include "libm.h" /* atan2f */ +#include "complex_wrapper.h" + +float +cargf(fcomplex z) { + return (atan2f(F_IM(z), F_RE(z))); +} diff --git a/usr/src/lib/libm/common/complex/cargl.c b/usr/src/lib/libm/common/complex/cargl.c new file mode 100644 index 0000000000..e3338da415 --- /dev/null +++ b/usr/src/lib/libm/common/complex/cargl.c @@ -0,0 +1,38 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cargl = __cargl + +#include "libm.h" +#include "complex_wrapper.h" + +long double +cargl(ldcomplex z) { + return (atan2l(LD_IM(z), LD_RE(z))); +} diff --git a/usr/src/lib/libm/common/complex/casin.c b/usr/src/lib/libm/common/complex/casin.c new file mode 100644 index 0000000000..5fdbb63dc2 --- /dev/null +++ b/usr/src/lib/libm/common/complex/casin.c @@ -0,0 +1,379 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak casin = __casin + +/* INDENT OFF */ +/* + * dcomplex casin(dcomplex z); + * + * Alogrithm + * (based on T.E.Hull, Thomas F. Fairgrieve and Ping Tak Peter Tang's + * paper "Implementing the Complex Arcsine and Arccosine Functins Using + * Exception Handling", ACM TOMS, Vol 23, pp 299-335) + * + * The principal value of complex inverse sine function casin(z), + * where z = x+iy, can be defined by + * + * casin(z) = asin(B) + i sign(y) log (A + sqrt(A*A-1)), + * + * where the log function is the natural log, and + * ____________ ____________ + * 1 / 2 2 1 / 2 2 + * A = --- / (x+1) + y + --- / (x-1) + y + * 2 \/ 2 \/ + * ____________ ____________ + * 1 / 2 2 1 / 2 2 + * B = --- / (x+1) + y - --- / (x-1) + y . + * 2 \/ 2 \/ + * + * The Branch cuts are on the real line from -inf to -1 and from 1 to inf. + * The real and imaginary parts are based on Abramowitz and Stegun + * [Handbook of Mathematic Functions, 1972]. The sign of the imaginary + * part is chosen to be the generally considered the principal value of + * this function. + * + * Notes:1. A is the average of the distances from z to the points (1,0) + * and (-1,0) in the complex z-plane, and in particular A>=1. + * 2. B is in [-1,1], and A*B = x. + * + * Special notes: if casin( x, y) = ( u, v), then + * casin(-x, y) = (-u, v), + * casin( x,-y) = ( u,-v), + * in general, we have casin(conj(z)) = conj(casin(z)) + * casin(-z) = -casin(z) + * casin(z) = pi/2 - cacos(z) + * + * EXCEPTION CASES (conform to ISO/IEC 9899:1999(E)): + * casin( 0 + i 0 ) = 0 + i 0 + * casin( 0 + i NaN ) = 0 + i NaN + * casin( x + i inf ) = 0 + i inf for finite x + * casin( x + i NaN ) = NaN + i NaN with invalid for finite x != 0 + * casin(inf + iy ) = pi/2 + i inf finite y + * casin(inf + i inf) = pi/4 + i inf + * casin(inf + i NaN) = NaN + i inf + * casin(NaN + i y ) = NaN + i NaN for finite y + * casin(NaN + i inf) = NaN + i inf + * casin(NaN + i NaN) = NaN + i NaN + * + * Special Regions (better formula for accuracy and for avoiding spurious + * overflow or underflow) (all x and y are assumed nonnegative): + * case 1: y = 0 + * case 2: tiny y relative to x-1: y <= ulp(0.5)*|x-1| + * case 3: tiny y: y < 4 sqrt(u), where u = minimum normal number + * case 4: huge y relative to x+1: y >= (1+x)/ulp(0.5) + * case 5: huge x and y: x and y >= sqrt(M)/8, where M = maximum normal number + * case 6: tiny x: x < 4 sqrt(u) + * -------- + * case 1 & 2. y=0 or y/|x-1| is tiny. We have + * ____________ _____________ + * / 2 2 / y 2 + * / (x+-1) + y = |x+-1| / 1 + (------) + * \/ \/ |x+-1| + * + * 1 y 2 + * ~ |x+-1| ( 1 + --- (------) ) + * 2 |x+-1| + * + * 2 + * y + * = |x+-1| + --------. + * 2|x+-1| + * + * Consequently, it is not difficult to see that + * 2 + * y + * [ 1 + ------------ , if x < 1, + * [ 2(1+x)(1-x) + * [ + * [ + * [ x, if x = 1 (y = 0), + * [ + * A ~= [ 2 + * [ x * y + * [ x + ------------ , if x > 1 + * [ 2(1+x)(x-1) + * + * and hence + * ______ 2 + * / 2 y y + * A + \/ A - 1 ~ 1 + ---------------- + -----------, if x < 1, + * sqrt((x+1)(1-x)) 2(x+1)(1-x) + * + * + * ~ x + sqrt((x-1)*(x+1)), if x >= 1. + * + * 2 + * y + * [ x(1 - ------------), if x < 1, + * [ 2(1+x)(1-x) + * B = x/A ~ [ + * [ 1, if x = 1, + * [ + * [ 2 + * [ y + * [ 1 - ------------ , if x > 1, + * [ 2(1+x)(1-x) + * Thus + * [ asin(x) + i y/sqrt((x-1)*(x+1)), if x < 1 + * casin(x+i*y)=[ + * [ pi/2 + i log(x+sqrt(x*x-1)), if x >= 1 + * + * case 3. y < 4 sqrt(u), where u = minimum normal x. + * After case 1 and 2, this will only occurs when x=1. When x=1, we have + * A = (sqrt(4+y*y)+y)/2 ~ 1 + y/2 + y^2/8 + ... + * and + * B = 1/A = 1 - y/2 + y^2/8 + ... + * Since + * asin(x) = pi/2-2*asin(sqrt((1-x)/2)) + * asin(x) = x + x^3/6 + x^5*3/40 + x^7*15/336 + ... + * we have, for the real part asin(B), + * asin(1-y/2) ~ pi/2 - 2 asin(sqrt(y/4)) + * ~ pi/2 - sqrt(y) + * For the imaginary part, + * log(A+sqrt(A*A-1)) ~ log(1+y/2+sqrt(2*y/2)) + * = log(1+y/2+sqrt(y)) + * = (y/2+sqrt(y)) - (y/2+sqrt(y))^2/2 + ... + * ~ sqrt(y) - y*(sqrt(y)+y/2)/2 + * ~ sqrt(y) + * + * case 4. y >= (x+1)ulp(0.5). In this case, A ~ y and B ~ x/y. Thus + * real part = asin(B) ~ x/y (be careful, x/y may underflow) + * and + * imag part = log(y+sqrt(y*y-one)) + * + * + * case 5. Both x and y are large: x and y > sqrt(M)/8, where M = maximum x + * In this case, + * A ~ sqrt(x*x+y*y) + * B ~ x/sqrt(x*x+y*y). + * Thus + * real part = asin(B) = atan(x/y), + * imag part = log(A+sqrt(A*A-1)) ~ log(2A) + * = log(2) + 0.5*log(x*x+y*y) + * = log(2) + log(y) + 0.5*log(1+(x/y)^2) + * + * case 6. x < 4 sqrt(u). In this case, we have + * A ~ sqrt(1+y*y), B = x/sqrt(1+y*y). + * Since B is tiny, we have + * real part = asin(B) ~ B = x/sqrt(1+y*y) + * imag part = log(A+sqrt(A*A-1)) = log (A+sqrt(y*y)) + * = log(y+sqrt(1+y*y)) + * = 0.5*log(y^2+2ysqrt(1+y^2)+1+y^2) + * = 0.5*log(1+2y(y+sqrt(1+y^2))); + * = 0.5*log1p(2y(y+A)); + * + * casin(z) = asin(B) + i sign(y) log (A + sqrt(A*A-1)), + */ +/* INDENT ON */ + +#include "libm.h" /* asin/atan/fabs/log/log1p/sqrt */ +#include "complex_wrapper.h" + +/* INDENT OFF */ +static const double + zero = 0.0, + one = 1.0, + E = 1.11022302462515654042e-16, /* 2**-53 */ + ln2 = 6.93147180559945286227e-01, + pi_2 = 1.570796326794896558e+00, + pi_2_l = 6.123233995736765886e-17, + pi_4 = 7.85398163397448278999e-01, + Foursqrtu = 5.96667258496016539463e-154, /* 2**(-509) */ + Acrossover = 1.5, + Bcrossover = 0.6417, + half = 0.5; +/* INDENT ON */ + +dcomplex +casin(dcomplex z) { + double x, y, t, R, S, A, Am1, B, y2, xm1, xp1, Apx; + int ix, iy, hx, hy; + unsigned lx, ly; + dcomplex ans; + + x = D_RE(z); + y = D_IM(z); + hx = HI_WORD(x); + lx = LO_WORD(x); + hy = HI_WORD(y); + ly = LO_WORD(y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + x = fabs(x); + y = fabs(y); + + /* special cases */ + + /* x is inf or NaN */ + if (ix >= 0x7ff00000) { /* x is inf or NaN */ + if (ISINF(ix, lx)) { /* x is INF */ + D_IM(ans) = x; + if (iy >= 0x7ff00000) { + if (ISINF(iy, ly)) + /* casin(inf + i inf) = pi/4 + i inf */ + D_RE(ans) = pi_4; + else /* casin(inf + i NaN) = NaN + i inf */ + D_RE(ans) = y + y; + } else /* casin(inf + iy) = pi/2 + i inf */ + D_RE(ans) = pi_2; + } else { /* x is NaN */ + if (iy >= 0x7ff00000) { + /* INDENT OFF */ + /* + * casin(NaN + i inf) = NaN + i inf + * casin(NaN + i NaN) = NaN + i NaN + */ + /* INDENT ON */ + D_IM(ans) = y + y; + D_RE(ans) = x + x; + } else { + /* casin(NaN + i y ) = NaN + i NaN */ + D_IM(ans) = D_RE(ans) = x + y; + } + } + if (hx < 0) + D_RE(ans) = -D_RE(ans); + if (hy < 0) + D_IM(ans) = -D_IM(ans); + return (ans); + } + + /* casin(+0 + i 0 ) = 0 + i 0. */ + if ((ix | lx | iy | ly) == 0) + return (z); + + if (iy >= 0x7ff00000) { /* y is inf or NaN */ + if (ISINF(iy, ly)) { /* casin(x + i inf) = 0 + i inf */ + D_IM(ans) = y; + D_RE(ans) = zero; + } else { /* casin(x + i NaN) = NaN + i NaN */ + D_IM(ans) = x + y; + if ((ix | lx) == 0) + D_RE(ans) = x; + else + D_RE(ans) = y; + } + if (hx < 0) + D_RE(ans) = -D_RE(ans); + if (hy < 0) + D_IM(ans) = -D_IM(ans); + return (ans); + } + + if ((iy | ly) == 0) { /* region 1: y=0 */ + if (ix < 0x3ff00000) { /* |x| < 1 */ + D_RE(ans) = asin(x); + D_IM(ans) = zero; + } else { + D_RE(ans) = pi_2; + if (ix >= 0x43500000) /* |x| >= 2**54 */ + D_IM(ans) = ln2 + log(x); + else if (ix >= 0x3ff80000) /* x > Acrossover */ + D_IM(ans) = log(x + sqrt((x - one) * (x + + one))); + else { + xm1 = x - one; + D_IM(ans) = log1p(xm1 + sqrt(xm1 * (x + one))); + } + } + } else if (y <= E * fabs(x - one)) { /* region 2: y < tiny*|x-1| */ + if (ix < 0x3ff00000) { /* x < 1 */ + D_RE(ans) = asin(x); + D_IM(ans) = y / sqrt((one + x) * (one - x)); + } else { + D_RE(ans) = pi_2; + if (ix >= 0x43500000) { /* |x| >= 2**54 */ + D_IM(ans) = ln2 + log(x); + } else if (ix >= 0x3ff80000) /* x > Acrossover */ + D_IM(ans) = log(x + sqrt((x - one) * (x + + one))); + else + D_IM(ans) = log1p((x - one) + sqrt((x - one) * + (x + one))); + } + } else if (y < Foursqrtu) { /* region 3 */ + t = sqrt(y); + D_RE(ans) = pi_2 - (t - pi_2_l); + D_IM(ans) = t; + } else if (E * y - one >= x) { /* region 4 */ + D_RE(ans) = x / y; /* need to fix underflow cases */ + D_IM(ans) = ln2 + log(y); + } else if (ix >= 0x5fc00000 || iy >= 0x5fc00000) { /* x,y>2**509 */ + /* region 5: x+1 or y is very large (>= sqrt(max)/8) */ + t = x / y; + D_RE(ans) = atan(t); + D_IM(ans) = ln2 + log(y) + half * log1p(t * t); + } else if (x < Foursqrtu) { + /* region 6: x is very small, < 4sqrt(min) */ + A = sqrt(one + y * y); + D_RE(ans) = x / A; /* may underflow */ + if (iy >= 0x3ff80000) /* if y > Acrossover */ + D_IM(ans) = log(y + A); + else + D_IM(ans) = half * log1p((y + y) * (y + A)); + } else { /* safe region */ + y2 = y * y; + xp1 = x + one; + xm1 = x - one; + R = sqrt(xp1 * xp1 + y2); + S = sqrt(xm1 * xm1 + y2); + A = half * (R + S); + B = x / A; + + if (B <= Bcrossover) + D_RE(ans) = asin(B); + else { /* use atan and an accurate approx to a-x */ + Apx = A + x; + if (x <= one) + D_RE(ans) = atan(x / sqrt(half * Apx * (y2 / + (R + xp1) + (S - xm1)))); + else + D_RE(ans) = atan(x / (y * sqrt(half * (Apx / + (R + xp1) + Apx / (S + xm1))))); + } + if (A <= Acrossover) { + /* use log1p and an accurate approx to A-1 */ + if (x < one) + Am1 = half * (y2 / (R + xp1) + y2 / (S - xm1)); + else + Am1 = half * (y2 / (R + xp1) + (S + xm1)); + D_IM(ans) = log1p(Am1 + sqrt(Am1 * (A + one))); + } else { + D_IM(ans) = log(A + sqrt(A * A - one)); + } + } + + if (hx < 0) + D_RE(ans) = -D_RE(ans); + if (hy < 0) + D_IM(ans) = -D_IM(ans); + + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/casinf.c b/usr/src/lib/libm/common/complex/casinf.c new file mode 100644 index 0000000000..7346c0ae7e --- /dev/null +++ b/usr/src/lib/libm/common/complex/casinf.c @@ -0,0 +1,46 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak casinf = __casinf + +#include "libm.h" +#include "complex_wrapper.h" + +fcomplex +casinf(fcomplex z) { + dcomplex dz, dans; + fcomplex ans; + + D_RE(dz) = (double) (F_RE(z)); + D_IM(dz) = (double) (F_IM(z)); + dans = casin(dz); + F_RE(ans) = (float) (D_RE(dans)); + F_IM(ans) = (float) (D_IM(dans)); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/casinh.c b/usr/src/lib/libm/common/complex/casinh.c new file mode 100644 index 0000000000..8fac57ed50 --- /dev/null +++ b/usr/src/lib/libm/common/complex/casinh.c @@ -0,0 +1,52 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak casinh = __casinh + +/* INDENT OFF */ +/* + * dcomplex casinh(dcomplex z); + * casinh z = -i casin iz . + */ +/* INDENT ON */ + +#include "libm.h" +#include "complex_wrapper.h" + +dcomplex +casinh(dcomplex z) { + dcomplex w, r, ans; + + D_RE(w) = -D_IM(z); + D_IM(w) = D_RE(z); + r = casin(w); + D_RE(ans) = D_IM(r); + D_IM(ans) = -D_RE(r); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/casinhf.c b/usr/src/lib/libm/common/complex/casinhf.c new file mode 100644 index 0000000000..3db35cf257 --- /dev/null +++ b/usr/src/lib/libm/common/complex/casinhf.c @@ -0,0 +1,45 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak casinhf = __casinhf + +#include "libm.h" +#include "complex_wrapper.h" + +fcomplex +casinhf(fcomplex z) { + fcomplex w, r, ans; + + F_RE(w) = -F_IM(z); + F_IM(w) = F_RE(z); + r = casinf(w); + F_RE(ans) = F_IM(r); + F_IM(ans) = -F_RE(r); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/casinhl.c b/usr/src/lib/libm/common/complex/casinhl.c new file mode 100644 index 0000000000..65c1f87801 --- /dev/null +++ b/usr/src/lib/libm/common/complex/casinhl.c @@ -0,0 +1,45 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak casinhl = __casinhl + +#include "libm.h" +#include "complex_wrapper.h" + +ldcomplex +casinhl(ldcomplex z) { + ldcomplex w, r, ans; + + LD_RE(w) = -LD_IM(z); + LD_IM(w) = LD_RE(z); + r = casinl(w); + LD_RE(ans) = LD_IM(r); + LD_IM(ans) = -LD_RE(r); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/casinl.c b/usr/src/lib/libm/common/complex/casinl.c new file mode 100644 index 0000000000..8fe5e6c959 --- /dev/null +++ b/usr/src/lib/libm/common/complex/casinl.c @@ -0,0 +1,232 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak casinl = __casinl + +#include "libm.h" /* asinl/atanl/fabsl/isinfl/log1pl/logl/sqrtl */ +#include "complex_wrapper.h" +#include "longdouble.h" + +/* INDENT OFF */ +static const long double +zero = 0.0L, +one = 1.0L, +Acrossover = 1.5L, +Bcrossover = 0.6417L, +half = 0.5L, +ln2 = 6.931471805599453094172321214581765680755e-0001L, +Foursqrtu = 7.3344154702193886624856495681939326638255e-2466L, /* 2**-8189 */ +#if defined(__x86) +E = 5.4210108624275221700372640043497085571289e-20L, /* 2**-64 */ +pi_4 = 0.7853981633974483095739921312272713294078130L, +pi_4_l = 4.1668714592604391641479322342670193036704898e-20L, +pi_2 = 1.5707963267948966191479842624545426588156260L, +pi_2_l = 8.3337429185208783282958644685340386073409796e-20L; + +#else +E = 9.6296497219361792652798897129246365926905e-35L, /* 2**-113 */ +pi_4 = 0.7853981633974483096156608458198756993697670L, +pi_4_l = 2.1679525325309452561992610065108379921905808e-35L, +pi_2 = 1.5707963267948966192313216916397513987395340L, +pi_2_l = 4.3359050650618905123985220130216759843811616e-35L; + +#endif +/* INDENT ON */ + +#if defined(__x86) +static const int ip1 = 0x40400000; /* 2**65 */ +#else +static const int ip1 = 0x40710000; /* 2**114 */ +#endif + +ldcomplex +casinl(ldcomplex z) { + long double x, y, t, R, S, A, Am1, B, y2, xm1, xp1, Apx; + int ix, iy, hx, hy; + ldcomplex ans; + + x = LD_RE(z); + y = LD_IM(z); + hx = HI_XWORD(x); + hy = HI_XWORD(y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + x = fabsl(x); + y = fabsl(y); + + /* special cases */ + + /* x is inf or NaN */ + if (ix >= 0x7fff0000) { /* x is inf or NaN */ + if (isinfl(x)) { /* x is INF */ + LD_IM(ans) = x; + if (iy >= 0x7fff0000) { + if (isinfl(y)) + /* casin(inf + i inf) = pi/4 + i inf */ + LD_RE(ans) = pi_4 + pi_4_l; + else /* casin(inf + i NaN) = NaN + i inf */ + LD_RE(ans) = y + y; + } else /* casin(inf + iy) = pi/2 + i inf */ + LD_RE(ans) = pi_2 + pi_2_l; + } else { /* x is NaN */ + if (iy >= 0x7fff0000) { + /* INDENT OFF */ + /* + * casin(NaN + i inf) = NaN + i inf + * casin(NaN + i NaN) = NaN + i NaN + */ + /* INDENT ON */ + LD_IM(ans) = y + y; + LD_RE(ans) = x + x; + } else { + /* INDENT OFF */ + /* casin(NaN + i y ) = NaN + i NaN */ + /* INDENT ON */ + LD_IM(ans) = LD_RE(ans) = x + y; + } + } + if (hx < 0) + LD_RE(ans) = -LD_RE(ans); + if (hy < 0) + LD_IM(ans) = -LD_IM(ans); + return (ans); + } + + /* casin(+0 + i 0) = 0 + i 0. */ + if (x == zero && y == zero) + return (z); + + if (iy >= 0x7fff0000) { /* y is inf or NaN */ + if (isinfl(y)) { /* casin(x + i inf) = 0 + i inf */ + LD_IM(ans) = y; + LD_RE(ans) = zero; + } else { /* casin(x + i NaN) = NaN + i NaN */ + LD_IM(ans) = x + y; + if (x == zero) + LD_RE(ans) = x; + else + LD_RE(ans) = y; + } + if (hx < 0) + LD_RE(ans) = -LD_RE(ans); + if (hy < 0) + LD_IM(ans) = -LD_IM(ans); + return (ans); + } + + if (y == zero) { /* region 1: y=0 */ + if (ix < 0x3fff0000) { /* |x| < 1 */ + LD_RE(ans) = asinl(x); + LD_IM(ans) = zero; + } else { + LD_RE(ans) = pi_2 + pi_2_l; + if (ix >= ip1) /* |x| >= i386 ? 2**65 : 2**114 */ + LD_IM(ans) = ln2 + logl(x); + else if (ix >= 0x3fff8000) /* x > Acrossover */ + LD_IM(ans) = logl(x + sqrtl((x - one) * (x + + one))); + else { + xm1 = x - one; + LD_IM(ans) = log1pl(xm1 + sqrtl(xm1 * (x + + one))); + } + } + } else if (y <= E * fabsl(x - one)) { /* region 2: y < tiny*|x-1| */ + if (ix < 0x3fff0000) { /* x < 1 */ + LD_RE(ans) = asinl(x); + LD_IM(ans) = y / sqrtl((one + x) * (one - x)); + } else { + LD_RE(ans) = pi_2 + pi_2_l; + if (ix >= ip1) /* i386 ? 2**65 : 2**114 */ + LD_IM(ans) = ln2 + logl(x); + else if (ix >= 0x3fff8000) /* x > Acrossover */ + LD_IM(ans) = logl(x + sqrtl((x - one) * (x + + one))); + else + LD_IM(ans) = log1pl((x - one) + sqrtl((x - + one) * (x + one))); + } + } else if (y < Foursqrtu) { /* region 3 */ + t = sqrtl(y); + LD_RE(ans) = pi_2 - (t - pi_2_l); + LD_IM(ans) = t; + } else if (E * y - one >= x) { /* region 4 */ + LD_RE(ans) = x / y; /* need to fix underflow cases */ + LD_IM(ans) = ln2 + logl(y); + } else if (ix >= 0x5ffb0000 || iy >= 0x5ffb0000) { + /* region 5: x+1 and y are both (>= sqrt(max)/8) i.e. 2**8188 */ + t = x / y; + LD_RE(ans) = atanl(t); + LD_IM(ans) = ln2 + logl(y) + half * log1pl(t * t); + } else if (x < Foursqrtu) { + /* region 6: x is very small, < 4sqrt(min) */ + A = sqrtl(one + y * y); + LD_RE(ans) = x / A; /* may underflow */ + if (iy >= 0x3fff8000) /* if y > Acrossover */ + LD_IM(ans) = logl(y + A); + else + LD_IM(ans) = half * log1pl((y + y) * (y + A)); + } else { /* safe region */ + y2 = y * y; + xp1 = x + one; + xm1 = x - one; + R = sqrtl(xp1 * xp1 + y2); + S = sqrtl(xm1 * xm1 + y2); + A = half * (R + S); + B = x / A; + if (B <= Bcrossover) + LD_RE(ans) = asinl(B); + else { /* use atan and an accurate approx to a-x */ + Apx = A + x; + if (x <= one) + LD_RE(ans) = atanl(x / sqrtl(half * Apx * (y2 / + (R + xp1) + (S - xm1)))); + else + LD_RE(ans) = atanl(x / (y * sqrtl(half * (Apx / + (R + xp1) + Apx / (S + xm1))))); + } + if (A <= Acrossover) { + /* use log1p and an accurate approx to A-1 */ + if (x < one) + Am1 = half * (y2 / (R + xp1) + y2 / (S - xm1)); + else + Am1 = half * (y2 / (R + xp1) + (S + xm1)); + LD_IM(ans) = log1pl(Am1 + sqrtl(Am1 * (A + one))); + } else { + LD_IM(ans) = logl(A + sqrtl(A * A - one)); + } + } + + if (hx < 0) + LD_RE(ans) = -LD_RE(ans); + if (hy < 0) + LD_IM(ans) = -LD_IM(ans); + + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/catan.c b/usr/src/lib/libm/common/complex/catan.c new file mode 100644 index 0000000000..39446a07e7 --- /dev/null +++ b/usr/src/lib/libm/common/complex/catan.c @@ -0,0 +1,292 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak catan = __catan + +/* INDENT OFF */ +/* + * dcomplex catan(dcomplex z); + * + * If + * z = x + iy, + * + * then + * 1 ( 2x ) 1 2 2 + * Re w = - arctan(-----------) = - ATAN2(2x, 1 - x - y ) + * 2 ( 2 2) 2 + * (1 - x - y ) + * + * ( 2 2) + * 1 (x + (y+1) ) 1 4y + * Im w = - log(------------) .= --- log [ 1 + ------------- ] + * 4 ( 2 2) 4 2 2 + * (x + (y-1) ) x + (y-1) + * + * 2 16 3 y + * = t - 2t + -- t - ..., where t = ----------------- + * 3 x*x + (y-1)*(y-1) + * + * Note that: if catan( x, y) = ( u, v), then + * catan(-x, y) = (-u, v) + * catan( x,-y) = ( u,-v) + * + * Also, catan(x,y) = -i*catanh(-y,x), or + * catanh(x,y) = i*catan(-y,x) + * So, if catanh(y,x) = (v,u), then catan(x,y) = -i*(-v,u) = (u,v), i.e., + * catan(x,y) = (u,v) + * + * EXCEPTION CASES (conform to ISO/IEC 9899:1999(E)): + * catan( 0 , 0 ) = (0 , 0 ) + * catan( NaN, 0 ) = (NaN , 0 ) + * catan( 0 , 1 ) = (0 , +inf) with divide-by-zero + * catan( inf, y ) = (pi/2 , 0 ) for finite +y + * catan( NaN, y ) = (NaN , NaN ) with invalid for finite y != 0 + * catan( x , inf ) = (pi/2 , 0 ) for finite +x + * catan( inf, inf ) = (pi/2 , 0 ) + * catan( NaN, inf ) = (NaN , 0 ) + * catan( x , NaN ) = (NaN , NaN ) with invalid for finite x + * catan( inf, NaN ) = (pi/2 , +-0 ) + */ +/* INDENT ON */ + +#include "libm.h" /* atan/atan2/fabs/log/log1p */ +#include "complex_wrapper.h" + +/* INDENT OFF */ +static const double + pi_2 = 1.570796326794896558e+00, + zero = 0.0, + half = 0.5, + two = 2.0, + ln2 = 6.931471805599453094172321214581765680755e-0001, + one = 1.0; +/* INDENT ON */ + +dcomplex +catan(dcomplex z) { + dcomplex ans; + double x, y, ax, ay, t; + int hx, hy, ix, iy; + unsigned lx, ly; + + x = D_RE(z); + y = D_IM(z); + ax = fabs(x); + ay = fabs(y); + hx = HI_WORD(x); + lx = LO_WORD(x); + hy = HI_WORD(y); + ly = LO_WORD(y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + + /* x is inf or NaN */ + if (ix >= 0x7ff00000) { + if (ISINF(ix, lx)) { + D_RE(ans) = pi_2; + D_IM(ans) = zero; + } else { + D_RE(ans) = x + x; + if ((iy | ly) == 0 || (ISINF(iy, ly))) + D_IM(ans) = zero; + else + D_IM(ans) = (fabs(y) - ay) / (fabs(y) - ay); + } + } else if (iy >= 0x7ff00000) { + /* y is inf or NaN */ + if (ISINF(iy, ly)) { + D_RE(ans) = pi_2; + D_IM(ans) = zero; + } else { + D_RE(ans) = (fabs(x) - ax) / (fabs(x) - ax); + D_IM(ans) = y; + } + } else if ((ix | lx) == 0) { + /* INDENT OFF */ + /* + * x = 0 + * 1 1 + * A = --- * atan2(2x, 1-x*x-y*y) = --- atan2(0,1-|y|) + * 2 2 + * + * 1 [ (y+1)*(y+1) ] 1 2 1 2y + * B = - log [ ------------ ] = - log (1+ ---) or - log(1+ ----) + * 4 [ (y-1)*(y-1) ] 2 y-1 2 1-y + */ + /* INDENT ON */ + t = one - ay; + if (((iy - 0x3ff00000) | ly) == 0) { + /* y=1: catan(0,1)=(0,+inf) with 1/0 signal */ + D_IM(ans) = ay / ax; + D_RE(ans) = zero; + } else if (iy >= 0x3ff00000) { /* y>1 */ + D_IM(ans) = half * log1p(two / (-t)); + D_RE(ans) = pi_2; + } else { /* y<1 */ + D_IM(ans) = half * log1p((ay + ay) / t); + D_RE(ans) = zero; + } + } else if (iy < 0x3e200000 || ((ix - iy) >> 20) >= 30) { + /* INDENT OFF */ + /* + * Tiny y (relative to 1+|x|) + * |y| < E*(1+|x|) + * where E=2**-29, -35, -60 for double, double extended, quad precision + * + * 1 [ x<=1: atan(x) + * A = --- * atan2(2x, 1-x*x-y*y) ~ [ 1 1+x + * 2 [ x>=1: - atan2(2,(1-x)*(-----)) + * 2 x + * + * y/x + * B ~ t*(1-2t), where t = ----------------- is tiny + * x + (y-1)*(y-1)/x + */ + /* INDENT ON */ + if (ix < 0x3ff00000) + D_RE(ans) = atan(ax); + else + D_RE(ans) = half * atan2(two, (one - ax) * (one + + one / ax)); + if ((iy | ly) == 0) { + D_IM(ans) = ay; + } else { + if (ix < 0x3e200000) + t = ay / ((ay - one) * (ay - one)); + else if (ix > 0x41c00000) + t = (ay / ax) / ax; + else + t = ay / (ax * ax + (ay - one) * (ay - one)); + D_IM(ans) = t * (one - (t + t)); + } + } else if (iy >= 0x41c00000 && ((iy - ix) >> 20) >= 30) { + /* INDENT OFF */ + /* + * Huge y relative to 1+|x| + * |y| > Einv*(1+|x|), where Einv~2**(prec/2+3), + * 1 + * A ~ --- * atan2(2x, -y*y) ~ pi/2 + * 2 + * y + * B ~ t*(1-2t), where t = --------------- is tiny + * (y-1)*(y-1) + */ + /* INDENT ON */ + D_RE(ans) = pi_2; + t = (ay / (ay - one)) / (ay - one); + D_IM(ans) = t * (one - (t + t)); + } else if (((iy - 0x3ff00000) | ly) == 0) { + /* INDENT OFF */ + /* + * y = 1 + * 1 1 + * A = --- * atan2(2x, -x*x) = --- atan2(2,-x) + * 2 2 + * + * 1 [x*x + 4] 1 4 [ 0.5(log2-logx) if + * B = - log [-------] = - log (1+ ---) = [ |x|<E, else 0.25* + * 4 [ x*x ] 4 x*x [ log1p((2/x)*(2/x)) + */ + /* INDENT ON */ + D_RE(ans) = half * atan2(two, -ax); + if (ix < 0x3e200000) + D_IM(ans) = half * (ln2 - log(ax)); + else { + t = two / ax; + D_IM(ans) = 0.25 * log1p(t * t); + } + } else if (ix >= 0x43900000) { + /* INDENT OFF */ + /* + * Huge x: + * when |x| > 1/E^2, + * 1 pi + * A ~ --- * atan2(2x, -x*x-y*y) ~ --- + * 2 2 + * y y/x + * B ~ t*(1-2t), where t = --------------- = (-------------- )/x + * x*x+(y-1)*(y-1) 1+((y-1)/x)^2 + */ + /* INDENT ON */ + D_RE(ans) = pi_2; + t = ((ay / ax) / (one + ((ay - one) / ax) * ((ay - one) / + ax))) / ax; + D_IM(ans) = t * (one - (t + t)); + } else if (ix < 0x38b00000) { + /* INDENT OFF */ + /* + * Tiny x: + * when |x| < E^4, (note that y != 1) + * 1 1 + * A = --- * atan2(2x, 1-x*x-y*y) ~ --- * atan2(2x,(1-y)*(1+y)) + * 2 2 + * + * 1 [(y+1)*(y+1)] 1 2 1 2y + * B = - log [-----------] = - log (1+ ---) or - log(1+ ----) + * 4 [(y-1)*(y-1)] 2 y-1 2 1-y + */ + /* INDENT ON */ + D_RE(ans) = half * atan2(ax + ax, (one - ay) * (one + ay)); + if (iy >= 0x3ff00000) + D_IM(ans) = half * log1p(two / (ay - one)); + else + D_IM(ans) = half * log1p((ay + ay) / (one - ay)); + } else { + /* INDENT OFF */ + /* + * normal x,y + * 1 + * A = --- * atan2(2x, 1-x*x-y*y) + * 2 + * + * 1 [x*x+(y+1)*(y+1)] 1 4y + * B = - log [---------------] = - log (1+ -----------------) + * 4 [x*x+(y-1)*(y-1)] 4 x*x + (y-1)*(y-1) + */ + /* INDENT ON */ + t = one - ay; + if (iy >= 0x3fe00000 && iy < 0x40000000) { + /* y close to 1 */ + D_RE(ans) = half * (atan2((ax + ax), (t * (one + ay) - + ax * ax))); + } else if (ix >= 0x3fe00000 && ix < 0x40000000) { + /* x close to 1 */ + D_RE(ans) = half * atan2((ax + ax), ((one - ax) * + (one + ax) - ay * ay)); + } else + D_RE(ans) = half * atan2((ax + ax), ((one - ax * ax) - + ay * ay)); + D_IM(ans) = 0.25 * log1p((4.0 * ay) / (ax * ax + t * t)); + } + if (hx < 0) + D_RE(ans) = -D_RE(ans); + if (hy < 0) + D_IM(ans) = -D_IM(ans); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/catanf.c b/usr/src/lib/libm/common/complex/catanf.c new file mode 100644 index 0000000000..32796246ad --- /dev/null +++ b/usr/src/lib/libm/common/complex/catanf.c @@ -0,0 +1,138 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2005 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak catanf = __catanf + +#include "libm.h" +#include "complex_wrapper.h" + +#if defined(__i386) && !defined(__amd64) +extern int __swapRP(int); +#endif + +static const float + pi_2 = 1.570796326794896558e+00F, + zero = 0.0F, + half = 0.5F, + two = 2.0F, + one = 1.0F; + +fcomplex +catanf(fcomplex z) { + fcomplex ans; + float x, y, ax, ay, t; + double dx, dy, dt; + int hx, hy, ix, iy; + + x = F_RE(z); + y = F_IM(z); + ax = fabsf(x); + ay = fabsf(y); + hx = THE_WORD(x); + hy = THE_WORD(y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + + if (ix >= 0x7f800000) { /* x is inf or NaN */ + if (ix == 0x7f800000) { + F_RE(ans) = pi_2; + F_IM(ans) = zero; + } else { + F_RE(ans) = x * x; + if (iy == 0 || iy == 0x7f800000) + F_IM(ans) = zero; + else + F_IM(ans) = (fabsf(y) - ay) / (fabsf(y) - ay); + } + } else if (iy >= 0x7f800000) { /* y is inf or NaN */ + if (iy == 0x7f800000) { + F_RE(ans) = pi_2; + F_IM(ans) = zero; + } else { + F_RE(ans) = (fabsf(x) - ax) / (fabsf(x) - ax); + F_IM(ans) = y * y; + } + } else if (ix == 0) { + /* INDENT OFF */ + /* + * x = 0 + * 1 1 + * A = --- * atan2(2x, 1-x*x-y*y) = --- atan2(0,1-|y|) + * 2 2 + * + * 1 [ (y+1)*(y+1) ] 1 2 1 2y + * B = - log [ ----------- ] = - log (1+ ---) or - log(1+ ----) + * 4 [ (y-1)*(y-1) ] 2 y-1 2 1-y + */ + /* INDENT ON */ + t = one - ay; + if (iy == 0x3f800000) { + /* y=1: catan(0,1)=(0,+inf) with 1/0 signal */ + F_IM(ans) = ay / ax; + F_RE(ans) = zero; + } else if (iy > 0x3f800000) { /* y>1 */ + F_IM(ans) = half * log1pf(two / (-t)); + F_RE(ans) = pi_2; + } else { /* y<1 */ + F_IM(ans) = half * log1pf((ay + ay) / t); + F_RE(ans) = zero; + } + } else { + /* INDENT OFF */ + /* + * use double precision x,y + * 1 + * A = --- * atan2(2x, 1-x*x-y*y) + * 2 + * + * 1 [ x*x+(y+1)*(y+1) ] 1 4y + * B = - log [ --------------- ] = - log (1+ -----------------) + * 4 [ x*x+(y-1)*(y-1) ] 4 x*x + (y-1)*(y-1) + */ + /* INDENT ON */ +#if defined(__i386) && !defined(__amd64) + int rp = __swapRP(fp_extended); +#endif + dx = (double)ax; + dy = (double)ay; + F_RE(ans) = (float)(0.5 * atan2(dx + dx, + 1.0 - dx * dx - dy * dy)); + dt = dy - 1.0; + F_IM(ans) = (float)(0.25 * log1p(4.0 * dy / + (dx * dx + dt * dt))); +#if defined(__i386) && !defined(__amd64) + if (rp != fp_extended) + (void) __swapRP(rp); +#endif + } + if (hx < 0) + F_RE(ans) = -F_RE(ans); + if (hy < 0) + F_IM(ans) = -F_IM(ans); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/catanh.c b/usr/src/lib/libm/common/complex/catanh.c new file mode 100644 index 0000000000..7abe2f005a --- /dev/null +++ b/usr/src/lib/libm/common/complex/catanh.c @@ -0,0 +1,57 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak catanh = __catanh + +/* INDENT OFF */ +/* + * z := x + iy + * catanh(z) = -i catan(iz) + * = -i catan(-y+ix) + * = (Im(catan(-y+ix)), -Re(catan(-y+ix))) + */ +/* INDENT ON */ + +#include "libm.h" +#include "complex_wrapper.h" + +dcomplex +catanh(dcomplex z) { + double x, y; + dcomplex ans, ct; + + x = D_RE(z); + y = D_IM(z); + D_RE(z) = -y; + D_IM(z) = x; + ct = catan(z); + D_RE(ans) = D_IM(ct); + D_IM(ans) = -D_RE(ct); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/catanhf.c b/usr/src/lib/libm/common/complex/catanhf.c new file mode 100644 index 0000000000..51ff2042ed --- /dev/null +++ b/usr/src/lib/libm/common/complex/catanhf.c @@ -0,0 +1,48 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak catanhf = __catanhf + +#include "libm.h" +#include "complex_wrapper.h" + +fcomplex +catanhf(fcomplex z) { + float x, y; + fcomplex ans, ct; + + x = F_RE(z); + y = F_IM(z); + F_RE(z) = -y; + F_IM(z) = x; + ct = catanf(z); + F_RE(ans) = F_IM(ct); + F_IM(ans) = -F_RE(ct); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/catanhl.c b/usr/src/lib/libm/common/complex/catanhl.c new file mode 100644 index 0000000000..9676c46215 --- /dev/null +++ b/usr/src/lib/libm/common/complex/catanhl.c @@ -0,0 +1,48 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak catanhl = __catanhl + +#include "libm.h" +#include "complex_wrapper.h" + +ldcomplex +catanhl(ldcomplex z) { + long double x, y; + ldcomplex ans, ct; + + x = LD_RE(z); + y = LD_IM(z); + LD_RE(z) = -y; + LD_IM(z) = x; + ct = catanl(z); + LD_RE(ans) = LD_IM(ct); + LD_IM(ans) = -LD_RE(ct); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/catanl.c b/usr/src/lib/libm/common/complex/catanl.c new file mode 100644 index 0000000000..b0543ed8b0 --- /dev/null +++ b/usr/src/lib/libm/common/complex/catanl.c @@ -0,0 +1,329 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak catanl = __catanl + +/* INDENT OFF */ +/* + * ldcomplex catanl(ldcomplex z); + * + * Atan(z) return A + Bi where, + * 1 + * A = --- * atan2(2x, 1-x*x-y*y) + * 2 + * + * 1 [ x*x + (y+1)*(y+1) ] 1 4y + * B = --- log [ ----------------- ] = - log (1+ -----------------) + * 4 [ x*x + (y-1)*(y-1) ] 4 x*x + (y-1)*(y-1) + * + * 2 16 3 y + * = t - 2t + -- t - ..., where t = ----------------- + * 3 x*x + (y-1)*(y-1) + * Proof: + * Let w = atan(z=x+yi) = A + B i. Then tan(w) = z. + * Since sin(w) = (exp(iw)-exp(-iw))/(2i), cos(w)=(exp(iw)+exp(-iw))/(2), + * Let p = exp(iw), then z = tan(w) = ((p-1/p)/(p+1/p))/i, or + * iz = (p*p-1)/(p*p+1), or, after simplification, + * p*p = (1+iz)/(1-iz) ... (1) + * LHS of (1) = exp(2iw) = exp(2i(A+Bi)) = exp(-2B)*exp(2iA) + * = exp(-2B)*(cos(2A)+i*sin(2A)) ... (2) + * 1-y+ix (1-y+ix)*(1+y+ix) 1-x*x-y*y + 2xi + * RHS of (1) = ------ = ----------------- = --------------- ... (3) + * 1+y-ix (1+y)**2 + x**2 (1+y)**2 + x**2 + * + * Comparing the real and imaginary parts of (2) and (3), we have: + * cos(2A) : 1-x*x-y*y = sin(2A) : 2x + * and hence + * tan(2A) = 2x/(1-x*x-y*y), or + * A = 0.5 * atan2(2x, 1-x*x-y*y) ... (4) + * + * For the imaginary part B, Note that |p*p| = exp(-2B), and + * |1+iz| |i-z| hypot(x,(y-1)) + * |----| = |---| = -------------- + * |1-iz| |i+z| hypot(x,(y+1)) + * Thus + * x*x + (y+1)*(y+1) + * exp(4B) = -----------------, or + * x*x + (y-1)*(y-1) + * + * 1 [x^2+(y+1)^2] 1 4y + * B = - log [-----------] = - log(1+ -------------) ... (5) + * 4 [x^2+(y-1)^2] 4 x^2+(y-1)^2 + * + * QED. + * + * Note that: if catan( x, y) = ( u, v), then + * catan(-x, y) = (-u, v) + * catan( x,-y) = ( u,-v) + * + * Also, catan(x,y) = -i*catanh(-y,x), or + * catanh(x,y) = i*catan(-y,x) + * So, if catanh(y,x) = (v,u), then catan(x,y) = -i*(-v,u) = (u,v), i.e., + * catan(x,y) = (u,v) + * + * EXCEPTION CASES (conform to ISO/IEC 9899:1999(E)): + * catan( 0 , 0 ) = (0 , 0 ) + * catan( NaN, 0 ) = (NaN , 0 ) + * catan( 0 , 1 ) = (0 , +inf) with divide-by-zero + * catan( inf, y ) = (pi/2 , 0 ) for finite +y + * catan( NaN, y ) = (NaN , NaN ) with invalid for finite y != 0 + * catan( x , inf ) = (pi/2 , 0 ) for finite +x + * catan( inf, inf ) = (pi/2 , 0 ) + * catan( NaN, inf ) = (NaN , 0 ) + * catan( x , NaN ) = (NaN , NaN ) with invalid for finite x + * catan( inf, NaN ) = (pi/2 , +-0 ) + */ +/* INDENT ON */ + +#include "libm.h" /* atan2l/atanl/fabsl/isinfl/iszerol/log1pl/logl */ +#include "complex_wrapper.h" +#include "longdouble.h" + +/* INDENT OFF */ +static const long double +zero = 0.0L, +one = 1.0L, +two = 2.0L, +half = 0.5L, +ln2 = 6.931471805599453094172321214581765680755e-0001L, +pi_2 = 1.570796326794896619231321691639751442098584699687552910487472L, +#if defined(__x86) +E = 2.910383045673370361328125000000000000000e-11L, /* 2**-35 */ +Einv = 3.435973836800000000000000000000000000000e+10L; /* 2**+35 */ +#else +E = 8.673617379884035472059622406959533691406e-19L, /* 2**-60 */ +Einv = 1.152921504606846976000000000000000000000e18L; /* 2**+60 */ +#endif +/* INDENT ON */ + +ldcomplex +catanl(ldcomplex z) { + ldcomplex ans; + long double x, y, t1, ax, ay, t; + int hx, hy, ix, iy; + + x = LD_RE(z); + y = LD_IM(z); + ax = fabsl(x); + ay = fabsl(y); + hx = HI_XWORD(x); + hy = HI_XWORD(y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + + /* x is inf or NaN */ + if (ix >= 0x7fff0000) { + if (isinfl(x)) { + LD_RE(ans) = pi_2; + LD_IM(ans) = zero; + } else { + LD_RE(ans) = x + x; + if (iszerol(y) || (isinfl(y))) + LD_IM(ans) = zero; + else + LD_IM(ans) = (fabsl(y) - ay) / (fabsl(y) - ay); + } + } else if (iy >= 0x7fff0000) { + /* y is inf or NaN */ + if (isinfl(y)) { + LD_RE(ans) = pi_2; + LD_IM(ans) = zero; + } else { + LD_RE(ans) = (fabsl(x) - ax) / (fabsl(x) - ax); + LD_IM(ans) = y; + } + } else if (iszerol(x)) { + /* INDENT OFF */ + /* + * x = 0 + * 1 1 + * A = --- * atan2(2x, 1-x*x-y*y) = --- atan2(0,1-|y|) + * 2 2 + * + * 1 [ (y+1)*(y+1) ] 1 2 1 2y + * B = - log [ ----------- ] = - log (1+ ---) or - log(1+ ----) + * 4 [ (y-1)*(y-1) ] 2 y-1 2 1-y + */ + /* INDENT ON */ + t = one - ay; + if (ay == one) { + /* y=1: catan(0,1)=(0,+inf) with 1/0 signal */ + LD_IM(ans) = ay / ax; + LD_RE(ans) = zero; + } else if (ay > one) { /* y>1 */ + LD_IM(ans) = half * log1pl(two / (-t)); + LD_RE(ans) = pi_2; + } else { /* y<1 */ + LD_IM(ans) = half * log1pl((ay + ay) / t); + LD_RE(ans) = zero; + } + } else if (ay < E * (one + ax)) { + /* INDENT OFF */ + /* + * Tiny y (relative to 1+|x|) + * |y| < E*(1+|x|) + * where E=2**-29, -35, -60 for double, extended, quad precision + * + * 1 [x<=1: atan(x) + * A = - * atan2(2x,1-x*x-y*y) ~ [ 1 1+x + * 2 [x>=1: - atan2(2,(1-x)*(-----)) + * 2 x + * + * y/x + * B ~ t*(1-2t), where t = ----------------- is tiny + * x + (y-1)*(y-1)/x + * + * y + * (when x < 2**-60, t = ----------- ) + * (y-1)*(y-1) + */ + /* INDENT ON */ + if (ay == zero) + LD_IM(ans) = ay; + else { + t1 = ay - one; + if (ix < 0x3fc30000) + t = ay / (t1 * t1); + else if (ix > 0x403b0000) + t = (ay / ax) / ax; + else + t = ay / (ax * ax + t1 * t1); + LD_IM(ans) = t * (one - two * t); + } + if (ix < 0x3fff0000) + LD_RE(ans) = atanl(ax); + else + LD_RE(ans) = half * atan2l(two, (one - ax) * (one + + one / ax)); + + } else if (ay > Einv * (one + ax)) { + /* INDENT OFF */ + /* + * Huge y relative to 1+|x| + * |y| > Einv*(1+|x|), where Einv~2**(prec/2+3), + * 1 + * A ~ --- * atan2(2x, -y*y) ~ pi/2 + * 2 + * y + * B ~ t*(1-2t), where t = --------------- is tiny + * (y-1)*(y-1) + */ + /* INDENT ON */ + LD_RE(ans) = pi_2; + t = (ay / (ay - one)) / (ay - one); + LD_IM(ans) = t * (one - (t + t)); + } else if (ay == one) { + /* INDENT OFF */ + /* + * y=1 + * 1 1 + * A = - * atan2(2x, -x*x) = --- atan2(2,-x) + * 2 2 + * + * 1 [ x*x+4] 1 4 [ 0.5(log2-logx) if + * B = - log [ -----] = - log (1+ ---) = [ |x|<E, else 0.25* + * 4 [ x*x ] 4 x*x [ log1p((2/x)*(2/x)) + */ + /* INDENT ON */ + LD_RE(ans) = half * atan2l(two, -ax); + if (ax < E) + LD_IM(ans) = half * (ln2 - logl(ax)); + else { + t = two / ax; + LD_IM(ans) = 0.25L * log1pl(t * t); + } + } else if (ax > Einv * Einv) { + /* INDENT OFF */ + /* + * Huge x: + * when |x| > 1/E^2, + * 1 pi + * A ~ --- * atan2(2x, -x*x-y*y) ~ --- + * 2 2 + * y y/x + * B ~ t*(1-2t), where t = --------------- = (-------------- )/x + * x*x+(y-1)*(y-1) 1+((y-1)/x)^2 + */ + /* INDENT ON */ + LD_RE(ans) = pi_2; + t = ((ay / ax) / (one + ((ay - one) / ax) * ((ay - one) / + ax))) / ax; + LD_IM(ans) = t * (one - (t + t)); + } else if (ax < E * E * E * E) { + /* INDENT OFF */ + /* + * Tiny x: + * when |x| < E^4, (note that y != 1) + * 1 1 + * A = --- * atan2(2x, 1-x*x-y*y) ~ --- * atan2(2x,1-y*y) + * 2 2 + * + * 1 [ (y+1)*(y+1) ] 1 2 1 2y + * B = - log [ ----------- ] = - log (1+ ---) or - log(1+ ----) + * 4 [ (y-1)*(y-1) ] 2 y-1 2 1-y + */ + /* INDENT ON */ + LD_RE(ans) = half * atan2l(ax + ax, (one - ay) * (one + ay)); + if (ay > one) /* y>1 */ + LD_IM(ans) = half * log1pl(two / (ay - one)); + else /* y<1 */ + LD_IM(ans) = half * log1pl((ay + ay) / (one - ay)); + } else { + /* INDENT OFF */ + /* + * normal x,y + * 1 + * A = --- * atan2(2x, 1-x*x-y*y) + * 2 + * + * 1 [ x*x+(y+1)*(y+1) ] 1 4y + * B = - log [ --------------- ] = - log (1+ -----------------) + * 4 [ x*x+(y-1)*(y-1) ] 4 x*x + (y-1)*(y-1) + */ + /* INDENT ON */ + t = one - ay; + if (iy >= 0x3ffe0000 && iy < 0x40000000) { + /* y close to 1 */ + LD_RE(ans) = half * (atan2l((ax + ax), (t * (one + + ay) - ax * ax))); + } else if (ix >= 0x3ffe0000 && ix < 0x40000000) { + /* x close to 1 */ + LD_RE(ans) = half * atan2l((ax + ax), ((one - ax) * + (one + ax) - ay * ay)); + } else + LD_RE(ans) = half * atan2l((ax + ax), ((one - ax * + ax) - ay * ay)); + LD_IM(ans) = 0.25L * log1pl((4.0L * ay) / (ax * ax + t * t)); + } + if (hx < 0) + LD_RE(ans) = -LD_RE(ans); + if (hy < 0) + LD_IM(ans) = -LD_IM(ans); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/ccos.c b/usr/src/lib/libm/common/complex/ccos.c new file mode 100644 index 0000000000..c4a2edd945 --- /dev/null +++ b/usr/src/lib/libm/common/complex/ccos.c @@ -0,0 +1,55 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak ccos = __ccos + +/* INDENT OFF */ +/* + * dcomplex ccos(dcomplex z); + * + * z := x+iy; since ccos(iz) = cosh(z), we have + * ccos(z) = ccos((-1)*(-z)) = ccos(i*i*(-z)) + * = ccosh(i*(-z)) = ccosh(i*(-x-yi)) + * = ccosh(y-ix) + */ +/* INDENT ON */ + +#include "libm.h" +#include "complex_wrapper.h" + +dcomplex +ccos(dcomplex z) { + double x, y; + + x = D_RE(z); + y = D_IM(z); + D_RE(z) = y; + D_IM(z) = -x; + return (ccosh(z)); +} diff --git a/usr/src/lib/libm/common/complex/ccosf.c b/usr/src/lib/libm/common/complex/ccosf.c new file mode 100644 index 0000000000..a2686fc6f4 --- /dev/null +++ b/usr/src/lib/libm/common/complex/ccosf.c @@ -0,0 +1,44 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak ccosf = __ccosf + +#include "libm.h" +#include "complex_wrapper.h" + +fcomplex +ccosf(fcomplex z) { + float x, y; + + x = F_RE(z); + y = F_IM(z); + F_RE(z) = y; + F_IM(z) = -x; + return (ccoshf(z)); +} diff --git a/usr/src/lib/libm/common/complex/ccosh.c b/usr/src/lib/libm/common/complex/ccosh.c new file mode 100644 index 0000000000..836ab927c5 --- /dev/null +++ b/usr/src/lib/libm/common/complex/ccosh.c @@ -0,0 +1,135 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak ccosh = __ccosh + +/* INDENT OFF */ +/* + * dcomplex ccosh(dcomplex z); + * + * z -z x -x + * e + e e (cos(y)+i*sin(y)) + e (cos(-y)+i*sin(-y)) + * cosh z = -------------- = --------------------------------------------- + * 2 2 + * x -x x -x + * cos(y) ( e + e ) + i*sin(y) (e - e ) + * = -------------------------------------------- + * 2 + * + * = cos(y) cosh(x) + i sin(y) sinh(x) + * + * Implementation Note + * ------------------- + * + * |x| -|x| |x| -2|x| -2|x| -P-4 + * Note that e +- e = e ( 1 +- e ). If e < 2 , where + * + * P stands for the number of significant bits of the machine precision, + * |x| + * then the result will be rounded to e . Therefore, we have + * + * z + * e + * cosh z = ----- if |x| >= (P/2 + 2)*ln2 + * 2 + * + * EXCEPTION (conform to ISO/IEC 9899:1999(E)): + * ccosh(0,0)=(1,0) + * ccosh(0,inf)=(NaN,+-0) + * ccosh(0,NaN)=(NaN,+-0) + * ccosh(x,inf) = (NaN,NaN) for finite non-zero x + * ccosh(x,NaN) = (NaN,NaN) for finite non-zero x + * ccosh(inf,0) = (inf, 0) + * ccosh(inf,y) = (inf*cos(y),inf*sin(y)) for finite non-zero y + * ccosh(inf,inf) = (+-inf,NaN) + * ccosh(inf,NaN) = (+inf,NaN) + * ccosh(NaN,0) = (NaN,+-0) + * ccosh(NaN,y) = (NaN,NaN) for non-zero y + * ccosh(NaN,NaN) = (NaN,NaN) + */ +/* INDENT ON */ + +#include "libm.h" /* cosh/exp/fabs/scalbn/sinh/sincos/__k_cexp */ +#include "complex_wrapper.h" + +dcomplex +ccosh(dcomplex z) { + double t, x, y, S, C; + int hx, ix, lx, hy, iy, ly, n; + dcomplex ans; + + x = D_RE(z); + y = D_IM(z); + hx = HI_WORD(x); + lx = LO_WORD(x); + ix = hx & 0x7fffffff; + hy = HI_WORD(y); + ly = LO_WORD(y); + iy = hy & 0x7fffffff; + x = fabs(x); + y = fabs(y); + + (void) sincos(y, &S, &C); + if (ix >= 0x403c0000) { /* |x| > 28 = prec/2 (14,28,34,60) */ + if (ix >= 0x40862E42) { /* |x| > 709.78... ~ log(2**1024) */ + if (ix >= 0x7ff00000) { /* |x| is inf or NaN */ + if ((iy | ly) == 0) { + D_RE(ans) = x; + D_IM(ans) = y; + } else if (iy >= 0x7ff00000) { + D_RE(ans) = x; + D_IM(ans) = x - y; + } else { + D_RE(ans) = C * x; + D_IM(ans) = S * x; + } + } else { + t = __k_cexp(x, &n); + /* return exp(x)=t*2**n */ + D_RE(ans) = scalbn(C * t, n - 1); + D_IM(ans) = scalbn(S * t, n - 1); + } + } else { + t = exp(x) * 0.5; + D_RE(ans) = C * t; + D_IM(ans) = S * t; + } + } else { + if ((ix | lx) == 0) { /* x = 0, return (C,0) */ + D_RE(ans) = C; + D_IM(ans) = 0.0; + } else { + D_RE(ans) = C * cosh(x); + D_IM(ans) = S * sinh(x); + } + } + if ((hx ^ hy) < 0) + D_IM(ans) = -D_IM(ans); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/ccoshf.c b/usr/src/lib/libm/common/complex/ccoshf.c new file mode 100644 index 0000000000..873cf0aa03 --- /dev/null +++ b/usr/src/lib/libm/common/complex/ccoshf.c @@ -0,0 +1,100 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2005 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak ccoshf = __ccoshf + +#include "libm.h" +#include "complex_wrapper.h" + +#if defined(__i386) && !defined(__amd64) +extern int __swapRP(int); +#endif + +static const float zero = 0.0F, half = 0.5F; + +fcomplex +ccoshf(fcomplex z) { + float t, x, y, S, C; + double w; + int hx, ix, hy, iy, n; + fcomplex ans; + + x = F_RE(z); + y = F_IM(z); + hx = THE_WORD(x); + ix = hx & 0x7fffffff; + hy = THE_WORD(y); + iy = hy & 0x7fffffff; + x = fabsf(x); + y = fabsf(y); + + sincosf(y, &S, &C); + if (ix >= 0x41600000) { /* |x| > 14 = prec/2 (14,28,34,60) */ + if (ix >= 0x42B171AA) { /* |x| > 88.722... ~ log(2**128) */ + if (ix >= 0x7f800000) { /* |x| is inf or NaN */ + if (iy == 0) { + F_RE(ans) = x; + F_IM(ans) = y; + } else if (iy >= 0x7f800000) { + F_RE(ans) = x; + F_IM(ans) = x - y; + } else { + F_RE(ans) = C * x; + F_IM(ans) = S * x; + } + } else { +#if defined(__i386) && !defined(__amd64) + int rp = __swapRP(fp_extended); +#endif + /* return (C, S) * exp(x) / 2 */ + w = __k_cexp((double)x, &n); + F_RE(ans) = (float)scalbn(C * w, n - 1); + F_IM(ans) = (float)scalbn(S * w, n - 1); +#if defined(__i386) && !defined(__amd64) + if (rp != fp_extended) + (void) __swapRP(rp); +#endif + } + } else { + t = expf(x) * half; + F_RE(ans) = C * t; + F_IM(ans) = S * t; + } + } else { + if (ix == 0) { /* x = 0, return (C,0) */ + F_RE(ans) = C; + F_IM(ans) = zero; + } else { + F_RE(ans) = C * coshf(x); + F_IM(ans) = S * sinhf(x); + } + } + if ((hx ^ hy) < 0) + F_IM(ans) = -F_IM(ans); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/ccoshl.c b/usr/src/lib/libm/common/complex/ccoshl.c new file mode 100644 index 0000000000..0f65741c97 --- /dev/null +++ b/usr/src/lib/libm/common/complex/ccoshl.c @@ -0,0 +1,91 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak ccoshl = __ccoshl + +#include "libm.h" /* coshl/expl/fabsl/scalbnl/sincosl/sinhl/__k_cexpl */ +#include "complex_wrapper.h" + +/* INDENT OFF */ +static const long double zero = 0.0L, half = 0.5L; +/* INDENT ON */ + +ldcomplex +ccoshl(ldcomplex z) { + long double t, x, y, S, C; + int hx, ix, hy, iy, n; + ldcomplex ans; + + x = LD_RE(z); + y = LD_IM(z); + hx = HI_XWORD(x); + ix = hx & 0x7fffffff; + hy = HI_XWORD(y); + iy = hy & 0x7fffffff; + x = fabsl(x); + y = fabsl(y); + + (void) sincosl(y, &S, &C); + if (ix >= 0x4004e000) { /* |x| > 60 = prec/2 (14,28,34,60) */ + if (ix >= 0x400C62E4) { /* |x| > 11356.52... ~ log(2**16384) */ + if (ix >= 0x7fff0000) { /* |x| is inf or NaN */ + if (y == zero) { + LD_RE(ans) = x; + LD_IM(ans) = y; + } else if (iy >= 0x7fff0000) { + LD_RE(ans) = x; + LD_IM(ans) = x - y; + } else { + LD_RE(ans) = C * x; + LD_IM(ans) = S * x; + } + } else { + t = __k_cexpl(x, &n); + /* return exp(x)=t*2**n */ + LD_RE(ans) = scalbnl(C * t, n - 1); + LD_IM(ans) = scalbnl(S * t, n - 1); + } + } else { + t = expl(x) * half; + LD_RE(ans) = C * t; + LD_IM(ans) = S * t; + } + } else { + if (x == zero) { /* x = 0, return (C,0) */ + LD_RE(ans) = C; + LD_IM(ans) = zero; + } else { + LD_RE(ans) = C * coshl(x); + LD_IM(ans) = S * sinhl(x); + } + } + if ((hx ^ hy) < 0) + LD_IM(ans) = -LD_IM(ans); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/ccosl.c b/usr/src/lib/libm/common/complex/ccosl.c new file mode 100644 index 0000000000..8a822be99b --- /dev/null +++ b/usr/src/lib/libm/common/complex/ccosl.c @@ -0,0 +1,44 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak ccosl = __ccosl + +#include "libm.h" +#include "complex_wrapper.h" + +ldcomplex +ccosl(ldcomplex z) { + long double x, y; + + x = LD_RE(z); + y = LD_IM(z); + LD_RE(z) = y; + LD_IM(z) = -x; + return (ccoshl(z)); +} diff --git a/usr/src/lib/libm/common/complex/cexp.c b/usr/src/lib/libm/common/complex/cexp.c new file mode 100644 index 0000000000..9b85bc4843 --- /dev/null +++ b/usr/src/lib/libm/common/complex/cexp.c @@ -0,0 +1,116 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cexp = __cexp + +/* INDENT OFF */ +/* + * dcomplex cexp(dcomplex z); + * + * x+iy x + * e = e (cos(y)+i*sin(y)) + * + * Over/underflow issue + * -------------------- + * exp(x) may be huge but cos(y) or sin(y) may be tiny. So we use + * function __k_cexp(x,&n) to return exp(x) = __k_cexp(x,&n)*2**n. + * Thus if exp(x+iy) = A + Bi and t = __k_cexp(x,&n), then + * A = t*cos(y)*2**n, B = t*sin(y)*2**n + * + * Purge off all exceptional arguments: + * (x,0) --> (exp(x),0) for all x, include inf and NaN + * (+inf, y) --> (+inf, NaN) for inf, nan + * (-inf, y) --> (+-0, +-0) for y = inf, nan + * (x,+-inf/NaN) --> (NaN,NaN) for finite x + * For all other cases, return + * (x,y) --> exp(x)*cos(y)+i*exp(x)*sin(y)) + * + * Algorithm for out of range x and finite y + * 1. compute exp(x) in factor form (t=__k_cexp(x,&n))*2**n + * 2. compute sincos(y,&s,&c) + * 3. compute t*s+i*(t*c), then scale back to 2**n and return. + */ +/* INDENT ON */ + +#include "libm.h" /* exp/scalbn/sincos/__k_cexp */ +#include "complex_wrapper.h" + +static const double zero = 0.0; + +dcomplex +cexp(dcomplex z) { + dcomplex ans; + double x, y, t, c, s; + int n, ix, iy, hx, hy, lx, ly; + + x = D_RE(z); + y = D_IM(z); + hx = HI_WORD(x); + lx = LO_WORD(x); + hy = HI_WORD(y); + ly = LO_WORD(y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + if ((iy | ly) == 0) { /* y = 0 */ + D_RE(ans) = exp(x); + D_IM(ans) = y; + } else if (ISINF(ix, lx)) { /* x is +-inf */ + if (hx < 0) { + if (iy >= 0x7ff00000) { + D_RE(ans) = zero; + D_IM(ans) = zero; + } else { + sincos(y, &s, &c); + D_RE(ans) = zero * c; + D_IM(ans) = zero * s; + } + } else { + if (iy >= 0x7ff00000) { + D_RE(ans) = x; + D_IM(ans) = y - y; + } else { + (void) sincos(y, &s, &c); + D_RE(ans) = x * c; + D_IM(ans) = x * s; + } + } + } else { + (void) sincos(y, &s, &c); + if (ix >= 0x40862E42) { /* |x| > 709.78... ~ log(2**1024) */ + t = __k_cexp(x, &n); + D_RE(ans) = scalbn(t * c, n); + D_IM(ans) = scalbn(t * s, n); + } else { + t = exp(x); + D_RE(ans) = t * c; + D_IM(ans) = t * s; + } + } + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/cexpf.c b/usr/src/lib/libm/common/complex/cexpf.c new file mode 100644 index 0000000000..411b6d4f6e --- /dev/null +++ b/usr/src/lib/libm/common/complex/cexpf.c @@ -0,0 +1,96 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2005 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cexpf = __cexpf + +#include "libm.h" +#include "complex_wrapper.h" + +#if defined(__i386) && !defined(__amd64) +extern int __swapRP(int); +#endif + +static const float zero = 0.0F; + +fcomplex +cexpf(fcomplex z) { + fcomplex ans; + float x, y, c, s; + double t; + int n, ix, iy, hx, hy; + + x = F_RE(z); + y = F_IM(z); + hx = THE_WORD(x); + hy = THE_WORD(y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + if (iy == 0) { /* y = 0 */ + F_RE(ans) = expf(x); + F_IM(ans) = y; + } else if (ix == 0x7f800000) { /* x is +-inf */ + if (hx < 0) { + if (iy >= 0x7f800000) { + F_RE(ans) = zero; + F_IM(ans) = zero; + } else { + sincosf(y, &s, &c); + F_RE(ans) = zero * c; + F_IM(ans) = zero * s; + } + } else { + if (iy >= 0x7f800000) { + F_RE(ans) = x; + F_IM(ans) = y - y; + } else { + sincosf(y, &s, &c); + F_RE(ans) = x * c; + F_IM(ans) = x * s; + } + } + } else { + sincosf(y, &s, &c); + if (ix >= 0x42B171AA) { /* |x| > 88.722... ~ log(2**128) */ +#if defined(__i386) && !defined(__amd64) + int rp = __swapRP(fp_extended); +#endif + t = __k_cexp(x, &n); + F_RE(ans) = (float)scalbn(t * (double)c, n); + F_IM(ans) = (float)scalbn(t * (double)s, n); +#if defined(__i386) && !defined(__amd64) + if (rp != fp_extended) + (void) __swapRP(rp); +#endif + } else { + t = expf(x); + F_RE(ans) = t * c; + F_IM(ans) = t * s; + } + } + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/cexpl.c b/usr/src/lib/libm/common/complex/cexpl.c new file mode 100644 index 0000000000..bccd9ba415 --- /dev/null +++ b/usr/src/lib/libm/common/complex/cexpl.c @@ -0,0 +1,90 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cexpl = __cexpl + +#include "libm.h" /* expl/isinfl/iszerol/scalbnl/sincosl */ +#include "complex_wrapper.h" + +extern int isinfl(long double); +extern int iszerol(long double); + +/* INDENT OFF */ +static const long double zero = 0.0L; +/* INDENT ON */ + +ldcomplex +cexpl(ldcomplex z) { + ldcomplex ans; + long double x, y, t, c, s; + int n, ix, iy, hx, hy; + + x = LD_RE(z); + y = LD_IM(z); + hx = HI_XWORD(x); + hy = HI_XWORD(y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + if (iszerol(y)) { /* y = 0 */ + LD_RE(ans) = expl(x); + LD_IM(ans) = y; + } else if (isinfl(x)) { /* x is +-inf */ + if (hx < 0) { + if (iy >= 0x7fff0000) { + LD_RE(ans) = zero; + LD_IM(ans) = zero; + } else { + sincosl(y, &s, &c); + LD_RE(ans) = zero * c; + LD_IM(ans) = zero * s; + } + } else { + if (iy >= 0x7fff0000) { + LD_RE(ans) = x; + LD_IM(ans) = y - y; + } else { + (void) sincosl(y, &s, &c); + LD_RE(ans) = x * c; + LD_IM(ans) = x * s; + } + } + } else { + (void) sincosl(y, &s, &c); + if (ix >= 0x400C62E4) { /* |x| > 11356.52... ~ log(2**16384) */ + t = __k_cexpl(x, &n); + LD_RE(ans) = scalbnl(t * c, n); + LD_IM(ans) = scalbnl(t * s, n); + } else { + t = expl(x); + LD_RE(ans) = t * c; + LD_IM(ans) = t * s; + } + } + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/cimag.c b/usr/src/lib/libm/common/complex/cimag.c new file mode 100644 index 0000000000..ac9edd2549 --- /dev/null +++ b/usr/src/lib/libm/common/complex/cimag.c @@ -0,0 +1,38 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cimag = __cimag + +#include "libm.h" +#include "complex_wrapper.h" + +double +cimag(dcomplex z) { + return (D_IM(z)); +} diff --git a/usr/src/lib/libm/common/complex/cimagf.c b/usr/src/lib/libm/common/complex/cimagf.c new file mode 100644 index 0000000000..89768f9760 --- /dev/null +++ b/usr/src/lib/libm/common/complex/cimagf.c @@ -0,0 +1,38 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cimagf = __cimagf + +#include "libm.h" +#include "complex_wrapper.h" + +float +cimagf(fcomplex z) { + return (F_IM(z)); +} diff --git a/usr/src/lib/libm/common/complex/cimagl.c b/usr/src/lib/libm/common/complex/cimagl.c new file mode 100644 index 0000000000..a80d65a14a --- /dev/null +++ b/usr/src/lib/libm/common/complex/cimagl.c @@ -0,0 +1,38 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cimagl = __cimagl + +#include "libm.h" +#include "complex_wrapper.h" + +long double +cimagl(ldcomplex z) { + return (LD_IM(z)); +} diff --git a/usr/src/lib/libm/common/complex/clog.c b/usr/src/lib/libm/common/complex/clog.c new file mode 100644 index 0000000000..eb8492e4bf --- /dev/null +++ b/usr/src/lib/libm/common/complex/clog.c @@ -0,0 +1,134 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2005 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak clog = __clog + +/* INDENT OFF */ +/* + * dcomplex clog(dcomplex z); + * + * _________ + * / 2 2 -1 y + * log(x+iy) = log(\/ x + y ) + i tan (---) + * x + * + * 1 2 2 -1 y + * = --- log(x + y ) + i tan (---) + * 2 x + * + * Note that the arctangent ranges from -PI to +PI, thus the imaginary + * part of clog is atan2(y,x). + * + * EXCEPTION CASES (conform to ISO/IEC 9899:1999(E)): + * clog(-0 + i 0 ) = -inf + i pi + * clog( 0 + i 0 ) = -inf + i 0 + * clog( x + i inf ) = -inf + i pi/2, for finite x + * clog( x + i NaN ) = NaN + i NaN with invalid for finite x + * clog(-inf + iy )= +inf + i pi, for finite positive-signed y + * clog(+inf + iy )= +inf + i 0 , for finite positive-signed y + * clog(-inf + i inf)= inf + i 3pi/4 + * clog(+inf + i inf)= inf + i pi/4 + * clog(+-inf+ i NaN)= inf + i NaN + * clog(NaN + i y )= NaN + i NaN for finite y + * clog(NaN + i inf)= inf + i NaN + * clog(NaN + i NaN)= NaN + i NaN + */ +/* INDENT ON */ + +#include "libm_synonyms.h" +#include <math.h> /* atan2/fabs/log/log1p */ +#include "complex_wrapper.h" +#include "libm_protos.h" /* __k_clog_r */ + + +static const double half = 0.5, one = 1.0; + +dcomplex +clog(dcomplex z) { + dcomplex ans; + double x, y, t, ax, ay, w; + int n, ix, iy, hx, hy; + unsigned lx, ly; + + x = D_RE(z); + y = D_IM(z); + hx = HI_WORD(x); + lx = LO_WORD(x); + hy = HI_WORD(y); + ly = LO_WORD(y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + ay = fabs(y); + ax = fabs(x); + D_IM(ans) = carg(z); + if (ix < iy || (ix == iy && lx < ly)) { + /* swap x and y to force ax >= ay */ + t = ax; + ax = ay; + ay = t; + n = ix, ix = iy; + iy = n; + n = lx, lx = ly; + ly = n; + } + n = (ix - iy) >> 20; + if (ix >= 0x7ff00000) { /* x or y is Inf or NaN */ + if (ISINF(ix, lx)) + D_RE(ans) = ax; + else if (ISINF(iy, ly)) + D_RE(ans) = ay; + else + D_RE(ans) = ax * ay; + } else if ((iy | ly) == 0) { + D_RE(ans) = ((ix | lx) == 0)? -one / ax : log(ax); + } else if (((0x3fffffff - ix) ^ (ix - 0x3fe00000)) >= 0) { + /* 0.5 <= x < 2 */ + if (ix >= 0x3ff00000) { + if (((ix - 0x3ff00000) | lx) == 0) + D_RE(ans) = half * log1p(ay * ay); + else if (n >= 60) + D_RE(ans) = log(ax); + else + D_RE(ans) = half * (log1p(ay * ay + (ax - + one) * (ax + one))); + } else if (n >= 60) { + D_RE(ans) = log(ax); + } else { + D_RE(ans) = __k_clog_r(ax, ay, &w); + } + } else if (n >= 30) { + D_RE(ans) = log(ax); + } else if (ix < 0x5f300000 && iy >= 0x20b00000) { + /* 2**-500< y < x < 2**500 */ + D_RE(ans) = half * log(ax * ax + ay * ay); + } else { + t = ay / ax; + D_RE(ans) = log(ax) + half * log1p(t * t); + } + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/clogf.c b/usr/src/lib/libm/common/complex/clogf.c new file mode 100644 index 0000000000..93b04cd58c --- /dev/null +++ b/usr/src/lib/libm/common/complex/clogf.c @@ -0,0 +1,82 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2005 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak clogf = __clogf + +#include "libm.h" +#include "complex_wrapper.h" + +#if defined(__i386) && !defined(__amd64) +extern int __swapRP(int); +#endif + +fcomplex +clogf(fcomplex z) { + fcomplex ans; + float x, y, ax, ay; + double dx, dy; + int ix, iy, hx, hy; + + x = F_RE(z); + y = F_IM(z); + hx = THE_WORD(x); + hy = THE_WORD(y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + ay = fabsf(y); + ax = fabsf(x); + F_IM(ans) = atan2f(y, x); + if (ix >= 0x7f800000 || iy >= 0x7f800000) { + /* x or y is Inf or NaN */ + if (iy == 0x7f800000) + F_RE(ans) = ay; + else if (ix == 0x7f800000) + F_RE(ans) = ax; + else + F_RE(ans) = ax + ay; + } else { +#if defined(__i386) && !defined(__amd64) + int rp = __swapRP(fp_extended); +#endif + dx = (double)ax; + dy = (double)ay; + if (ix == 0x3f800000) + F_RE(ans) = (float)(0.5 * log1p(dy * dy)); + else if (iy == 0x3f800000) + F_RE(ans) = (float)(0.5 * log1p(dx * dx)); + else if ((ix | iy) == 0) + F_RE(ans) = -1.0f / ax; + else + F_RE(ans) = (float)(0.5 * log(dx * dx + dy * dy)); +#if defined(__i386) && !defined(__amd64) + if (rp != fp_extended) + (void) __swapRP(rp); +#endif + } + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/clogl.c b/usr/src/lib/libm/common/complex/clogl.c new file mode 100644 index 0000000000..87d584f8a5 --- /dev/null +++ b/usr/src/lib/libm/common/complex/clogl.c @@ -0,0 +1,105 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak clogl = __clogl + +#include "libm.h" /* atan2l/fabsl/isinfl/log1pl/logl/__k_clog_rl */ +#include "complex_wrapper.h" +#include "longdouble.h" + +#if defined(__sparc) +#define SIGP7 120 +#define HSIGP7 60 +#elif defined(__x86) +#define SIGP7 70 +#define HSIGP7 35 +#endif + +/* INDENT OFF */ +static const long double zero = 0.0L, half = 0.5L, one = 1.0L; +/* INDENT ON */ + +ldcomplex +clogl(ldcomplex z) { + ldcomplex ans; + long double x, y, t, ax, ay; + int n, ix, iy, hx, hy; + + x = LD_RE(z); + y = LD_IM(z); + hx = HI_XWORD(x); + hy = HI_XWORD(y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + ay = fabsl(y); + ax = fabsl(x); + LD_IM(ans) = atan2l(y, x); + if (ix < iy || (ix == iy && ix < 0x7fff0000 && ax < ay)) { + /* swap x and y to force ax>=ay */ + t = ax; + ax = ay; + ay = t; + n = ix, ix = iy; + iy = n; + } + n = (ix - iy) >> 16; + if (ix >= 0x7fff0000) { /* x or y is Inf or NaN */ + if (isinfl(ax)) + LD_RE(ans) = ax; + else if (isinfl(ay)) + LD_RE(ans) = ay; + else + LD_RE(ans) = ax + ay; + } else if (ay == zero) + LD_RE(ans) = logl(ax); + else if (((0x3fffffff - ix) ^ (ix - 0x3ffe0000)) >= 0) { + /* 0.5 <= x < 2 */ + if (ix >= 0x3fff0000) { + if (ax == one) + LD_RE(ans) = half * log1pl(ay * ay); + else if (n >= SIGP7) + LD_RE(ans) = logl(ax); + else + LD_RE(ans) = half * (log1pl(ay * ay + (ax - + one) * (ax + one))); + } else if (n >= SIGP7) + LD_RE(ans) = logl(ax); + else + LD_RE(ans) = __k_clog_rl(x, y, &t); + } else if (n >= HSIGP7) + LD_RE(ans) = logl(ax); + else if (ix < 0x5f3f0000 && iy >= 0x20bf0000) + /* 2**-8000 < y < x < 2**8000 */ + LD_RE(ans) = half * logl(ax * ax + ay * ay); + else { + t = ay / ax; + LD_RE(ans) = logl(ax) + half * log1pl(t * t); + } + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/complex_wrapper.h b/usr/src/lib/libm/common/complex/complex_wrapper.h new file mode 100644 index 0000000000..b86a9846eb --- /dev/null +++ b/usr/src/lib/libm/common/complex/complex_wrapper.h @@ -0,0 +1,89 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#ifndef _COMPLEX_WRAPPER_H +#define _COMPLEX_WRAPPER_H + +#pragma ident "@(#)complex_wrapper.h 1.7 06/01/31 SMI" + +#if defined(__GNUC__) +#define dcomplex double _Complex +#define fcomplex float _Complex +#define ldcomplex long double _Complex +#define D_RE(x) __real__ x +#define D_IM(x) __imag__ x +#define F_RE(x) __real__ x +#define F_IM(x) __imag__ x +#define LD_RE(x) __real__ x +#define LD_IM(x) __imag__ x + +#include <complex.h> +#else + +#define dcomplex double complex +#define fcomplex float complex +#define ldcomplex long double complex +#define _X_RE(__t, __z) ((__t *) &__z)[0] +#define _X_IM(__t, __z) ((__t *) &__z)[1] +#define D_RE(__z) _X_RE(double, __z) +#define D_IM(__z) _X_IM(double, __z) +#define F_RE(__z) _X_RE(float, __z) +#define F_IM(__z) _X_IM(float, __z) +#define LD_RE(__z) _X_RE(long double, __z) +#define LD_IM(__z) _X_IM(long double, __z) + +#include <complex.h> +#endif + +#if defined(__sparc) +#define HIWORD 0 +#define LOWORD 1 +#define HI_XWORD(x) ((unsigned *) &x)[0] +#define XFSCALE(x, n) ((unsigned *) &x)[0] += n << 16 /* signbitl(x) == 0 */ +#define CHOPPED(x) ((long double) ((double) (x))) +#elif defined(__x86) +#define HIWORD 1 +#define LOWORD 0 +#define HI_XWORD(x) ((((int *) &x)[2] << 16) | \ + (0xffff & ((unsigned *) &x)[1] >> 15)) +#define XFSCALE(x, n) ((unsigned short *) &x)[4] += n /* signbitl(x) == 0 */ +#define CHOPPED(x) ((long double) ((float) (x))) +#else +#error Unknown architecture +#endif +#define HI_WORD(x) ((int *) &x)[HIWORD] /* for double */ +#define LO_WORD(x) ((int *) &x)[LOWORD] /* for double */ +#define THE_WORD(x) ((int *) &x)[0] /* for float */ + +/* + * iy:ly must have the sign bit already cleared + */ +#define ISINF(iy, ly) (((iy - 0x7ff00000) | ly) == 0) + +#endif /* _COMPLEX_WRAPPER_H */ diff --git a/usr/src/lib/libm/common/complex/conj.c b/usr/src/lib/libm/common/complex/conj.c new file mode 100644 index 0000000000..9e3b4ea77a --- /dev/null +++ b/usr/src/lib/libm/common/complex/conj.c @@ -0,0 +1,39 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak conj = __conj + +#include "libm.h" +#include "complex_wrapper.h" + +dcomplex +conj(dcomplex z) { + D_IM(z) = -D_IM(z); + return (z); +} diff --git a/usr/src/lib/libm/common/complex/conjf.c b/usr/src/lib/libm/common/complex/conjf.c new file mode 100644 index 0000000000..417d333a7b --- /dev/null +++ b/usr/src/lib/libm/common/complex/conjf.c @@ -0,0 +1,39 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak conjf = __conjf + +#include "libm.h" +#include "complex_wrapper.h" + +fcomplex +conjf(fcomplex z) { + F_IM(z) = -F_IM(z); + return (z); +} diff --git a/usr/src/lib/libm/common/complex/conjl.c b/usr/src/lib/libm/common/complex/conjl.c new file mode 100644 index 0000000000..cdce73d37e --- /dev/null +++ b/usr/src/lib/libm/common/complex/conjl.c @@ -0,0 +1,39 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak conjl = __conjl + +#include "libm.h" +#include "complex_wrapper.h" + +ldcomplex +conjl(ldcomplex z) { + LD_IM(z) = -LD_IM(z); + return (z); +} diff --git a/usr/src/lib/libm/common/complex/cpow.c b/usr/src/lib/libm/common/complex/cpow.c new file mode 100644 index 0000000000..9fed91435a --- /dev/null +++ b/usr/src/lib/libm/common/complex/cpow.c @@ -0,0 +1,337 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cpow = __cpow + +/* INDENT OFF */ +/* + * dcomplex cpow(dcomplex z); + * + * z**w analytically equivalent to + * + * cpow(z,w) = cexp(w clog(z)) + * + * Let z = x+iy, w = u+iv. + * Since + * _________ + * / 2 2 -1 y + * log(x+iy) = log(\/ x + y ) + i tan (---) + * x + * + * 1 2 2 -1 y + * = --- log(x + y ) + i tan (---) + * 2 x + * u 2 2 -1 y + * (u+iv)* log(x+iy) = --- log(x + y ) - v tan (---) + (1) + * 2 x + * + * v 2 2 -1 y + * i * [ --- log(x + y ) + u tan (---) ] (2) + * 2 x + * + * = r + i q + * + * Therefore, + * w r+iq r + * z = e = e (cos(q)+i*sin(q)) + * _______ + * / 2 2 + * r \/ x + y -v*atan2(y,x) + * Here e can be expressed as: u * e + * + * Special cases (in the order of appearance): + * 1. (anything) ** 0 is 1 + * 2. (anything) ** 1 is itself + * 3. When v = 0, y = 0: + * If x is finite and negative, and u is finite, then + * x ** u = exp(u*pi i) * pow(|x|, u); + * otherwise, + * x ** u = pow(x, u); + * 4. When v = 0, x = 0 or |x| = |y| or x is inf or y is inf: + * (x + y i) ** u = r * exp(q i) + * where + * r = hypot(x,y) ** u + * q = u * atan2pi(y, x) + * + * 5. otherwise, z**w is NAN if any x, y, u, v is a Nan or inf + * + * Note: many results of special cases are obtained in terms of + * polar coordinate. In the conversion from polar to rectangle: + * r exp(q i) = r * cos(q) + r * sin(q) i, + * we regard r * 0 is 0 except when r is a NaN. + */ +/* INDENT ON */ + +#include "libm.h" /* atan2/exp/fabs/hypot/log/pow/scalbn */ + /* atan2pi/exp2/sincos/sincospi/__k_clog_r/__k_atan2 */ +#include "complex_wrapper.h" + +extern void sincospi(double, double *, double *); + +static const double + huge = 1e300, + tiny = 1e-300, + invln2 = 1.44269504088896338700e+00, + ln2hi = 6.93147180369123816490e-01, /* 0x3fe62e42, 0xfee00000 */ + ln2lo = 1.90821492927058770002e-10, /* 0x3dea39ef, 0x35793c76 */ + one = 1.0, + zero = 0.0; + +static const int hiinf = 0x7ff00000; +extern double atan2pi(double, double); + +/* + * Assuming |t[0]| > |t[1]| and |t[2]| > |t[3]|, sum4fp subroutine + * compute t[0] + t[1] + t[2] + t[3] into two double fp numbers. + */ +static double +sum4fp(double ta[], double *w) { + double t1, t2, t3, t4, w1, w2, t; + t1 = ta[0]; t2 = ta[1]; t3 = ta[2]; t4 = ta[3]; + /* + * Rearrange ti so that |t1| >= |t2| >= |t3| >= |t4| + */ + if (fabs(t4) > fabs(t1)) { + t = t1; t1 = t3; t3 = t; + t = t2; t2 = t4; t4 = t; + } else if (fabs(t3) > fabs(t1)) { + t = t1; t1 = t3; + if (fabs(t4) > fabs(t2)) { + t3 = t4; t4 = t2; t2 = t; + } else { + t3 = t2; t2 = t; + } + } else if (fabs(t3) > fabs(t2)) { + t = t2; t2 = t3; + if (fabs(t4) > fabs(t2)) { + t3 = t4; t4 = t; + } else + t3 = t; + } + /* summing r = t1 + t2 + t3 + t4 to w1 + w2 */ + w1 = t3 + t4; + w2 = t4 - (w1 - t3); + t = t2 + w1; + w2 += w1 - (t - t2); + w1 = t + w2; + w2 += t - w1; + t = t1 + w1; + w2 += w1 - (t - t1); + w1 = t + w2; + *w = w2 - (w1 - t); + return (w1); +} + +dcomplex +cpow(dcomplex z, dcomplex w) { + dcomplex ans; + double x, y, u, v, t, c, s, r, x2, y2; + double b[4], t1, t2, t3, t4, w1, w2, u1, v1, x1, y1; + int ix, iy, hx, lx, hy, ly, hv, hu, iu, iv, lu, lv; + int i, j, k; + + x = D_RE(z); + y = D_IM(z); + u = D_RE(w); + v = D_IM(w); + hx = ((int *) &x)[HIWORD]; + lx = ((int *) &x)[LOWORD]; + hy = ((int *) &y)[HIWORD]; + ly = ((int *) &y)[LOWORD]; + hu = ((int *) &u)[HIWORD]; + lu = ((int *) &u)[LOWORD]; + hv = ((int *) &v)[HIWORD]; + lv = ((int *) &v)[LOWORD]; + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + iu = hu & 0x7fffffff; + iv = hv & 0x7fffffff; + + j = 0; + if ((iv | lv) == 0) { /* z**(real) */ + if (((hu - 0x3ff00000) | lu) == 0) { /* z ** 1 = z */ + D_RE(ans) = x; + D_IM(ans) = y; + } else if ((iu | lu) == 0) { /* z ** 0 = 1 */ + D_RE(ans) = one; + D_IM(ans) = zero; + } else if ((iy | ly) == 0) { /* (real)**(real) */ + D_IM(ans) = zero; + if (hx < 0 && ix < hiinf && iu < hiinf) { + /* -x ** u is exp(i*pi*u)*pow(x,u) */ + r = pow(-x, u); + sincospi(u, &s, &c); + D_RE(ans) = (c == zero)? c: c * r; + D_IM(ans) = (s == zero)? s: s * r; + } else + D_RE(ans) = pow(x, u); + } else if (((ix | lx) == 0) || ix >= hiinf || iy >= hiinf) { + if (isnan(x) || isnan(y) || isnan(u)) + D_RE(ans) = D_IM(ans) = x + y + u; + else { + if ((ix | lx) == 0) + r = fabs(y); + else + r = fabs(x) + fabs(y); + t = atan2pi(y, x); + sincospi(t * u, &s, &c); + D_RE(ans) = (c == zero)? c: c * r; + D_IM(ans) = (s == zero)? s: s * r; + } + } else if (((ix - iy) | (lx - ly)) == 0) { /* |x| = |y| */ + if (hx >= 0) { + t = (hy >= 0)? 0.25 : -0.25; + sincospi(t * u, &s, &c); + } else if ((lu & 3) == 0) { + t = (hy >= 0)? 0.75 : -0.75; + sincospi(t * u, &s, &c); + } else { + r = (hy >= 0)? u : -u; + t = -0.25 * r; + w1 = r + t; + w2 = t - (w1 - r); + sincospi(w1, &t1, &t2); + sincospi(w2, &t3, &t4); + s = t1 * t4 + t3 * t2; + c = t2 * t4 - t1 * t3; + } + if (ix < 0x3fe00000) /* |x| < 1/2 */ + r = pow(fabs(x + x), u) * exp2(-0.5 * u); + else if (ix >= 0x3ff00000 || iu < 0x408ff800) + /* |x| >= 1 or |u| < 1023 */ + r = pow(fabs(x), u) * exp2(0.5 * u); + else /* special treatment */ + j = 2; + if (j == 0) { + D_RE(ans) = (c == zero)? c: c * r; + D_IM(ans) = (s == zero)? s: s * r; + } + } else + j = 1; + if (j == 0) + return (ans); + } + if (iu >= hiinf || iv >= hiinf || ix >= hiinf || iy >= hiinf) { + /* + * non-zero imag part(s) with inf component(s) yields NaN + */ + t = fabs(x) + fabs(y) + fabs(u) + fabs(v); + D_RE(ans) = D_IM(ans) = t - t; + } else { + k = 0; /* no scaling */ + if (iu > 0x7f000000 || iv > 0x7f000000) { + u *= .0009765625; /* scale 2**-10 to avoid overflow */ + v *= .0009765625; + k = 1; /* scale by 2**-10 */ + } + /* + * Use similated higher precision arithmetic to compute: + * r = u * log(hypot(x, y)) - v * atan2(y, x) + * q = u * atan2(y, x) + v * log(hypot(x, y)) + */ + t1 = __k_clog_r(x, y, &t2); + t3 = __k_atan2(y, x, &t4); + x1 = t1; + y1 = t3; + u1 = u; + v1 = v; + ((int *) &u1)[LOWORD] &= 0xf8000000; + ((int *) &v1)[LOWORD] &= 0xf8000000; + ((int *) &x1)[LOWORD] &= 0xf8000000; + ((int *) &y1)[LOWORD] &= 0xf8000000; + x2 = t2 - (x1 - t1); /* log(hypot(x,y)) = x1 + x2 */ + y2 = t4 - (y1 - t3); /* atan2(y,x) = y1 + y2 */ + /* compute q = u * atan2(y, x) + v * log(hypot(x, y)) */ + if (j != 2) { + b[0] = u1 * y1; + b[1] = (u - u1) * y1 + u * y2; + if (j == 1) { /* v = 0 */ + w1 = b[0] + b[1]; + w2 = b[1] - (w1 - b[0]); + } else { + b[2] = v1 * x1; + b[3] = (v - v1) * x1 + v * x2; + w1 = sum4fp(b, &w2); + } + sincos(w1, &t1, &t2); + sincos(w2, &t3, &t4); + s = t1 * t4 + t3 * t2; + c = t2 * t4 - t1 * t3; + if (k == 1) + /* + * square (cos(q) + i sin(q)) k times to get + * (cos(2^k * q + i sin(2^k * q) + */ + for (i = 0; i < 10; i++) { + t1 = s * c; + c = (c + s) * (c - s); + s = t1 + t1; + } + } + /* compute r = u * (t1, t2) - v * (t3, t4) */ + b[0] = u1 * x1; + b[1] = (u - u1) * x1 + u * x2; + if (j == 1) { /* v = 0 */ + w1 = b[0] + b[1]; + w2 = b[1] - (w1 - b[0]); + } else { + b[2] = -v1 * y1; + b[3] = (v1 - v) * y1 - v * y2; + w1 = sum4fp(b, &w2); + } + /* check over/underflow for exp(w1 + w2) */ + if (k && fabs(w1) < 1000.0) { + w1 *= 1024; w2 *= 1024; k = 0; + } + hx = ((int *) &w1)[HIWORD]; + lx = ((int *) &w1)[LOWORD]; + ix = hx & 0x7fffffff; + /* compute exp(w1 + w2) */ + if (ix < 0x3c900000) /* exp(tiny < 2**-54) = 1 */ + r = one; + else if (ix >= 0x40880000) /* overflow/underflow */ + r = (hx < 0)? tiny * tiny : huge * huge; + else { /* compute exp(w1 + w2) */ + k = (int) (invln2 * w1 + ((hx >= 0)? 0.5 : -0.5)); + t1 = (double) k; + t2 = w1 - t1 * ln2hi; + t3 = w2 - t1 * ln2lo; + r = exp(t2 + t3); + } + if (c != zero) c *= r; + if (s != zero) s *= r; + if (k != 0) { + c = scalbn(c, k); + s = scalbn(s, k); + } + D_RE(ans) = c; + D_IM(ans) = s; + } + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/cpowf.c b/usr/src/lib/libm/common/complex/cpowf.c new file mode 100644 index 0000000000..5c06c59757 --- /dev/null +++ b/usr/src/lib/libm/common/complex/cpowf.c @@ -0,0 +1,174 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2005 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cpowf = __cpowf + +#include "libm.h" +#include "complex_wrapper.h" + +extern void sincospi(double, double *, double *); +extern void sincospif(float, float *, float *); +extern double atan2pi(double, double); +extern float atan2pif(float, float); + +#if defined(__i386) && !defined(__amd64) +extern int __swapRP(int); +#endif + +static const double + dpi = 3.1415926535897931160E0, /* Hex 2^ 1 * 1.921FB54442D18 */ + dhalf = 0.5, + dsqrt2 = 1.41421356237309514547, /* 3FF6A09E 667F3BCD */ + dinvpi = 0.3183098861837906715377675; + +static const float one = 1.0F, zero = 0.0F; + +#define hiinf 0x7f800000 + +fcomplex +cpowf(fcomplex z, fcomplex w) { + fcomplex ans; + float x, y, u, v, t, c, s; + double dx, dy, du, dv, dt, dc, ds, dp, dq, dr; + int ix, iy, hx, hy, hv, hu, iu, iv, j; + + x = F_RE(z); + y = F_IM(z); + u = F_RE(w); + v = F_IM(w); + hx = THE_WORD(x); + hy = THE_WORD(y); + hu = THE_WORD(u); + hv = THE_WORD(v); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + iu = hu & 0x7fffffff; + iv = hv & 0x7fffffff; + + j = 0; + if (iv == 0) { /* z**(real) */ + if (hu == 0x3f800000) { /* (anything) ** 1 is itself */ + F_RE(ans) = x; + F_IM(ans) = y; + } else if (iu == 0) { /* (anything) ** 0 is 1 */ + F_RE(ans) = one; + F_IM(ans) = zero; + } else if (iy == 0) { /* (real)**(real) */ + F_IM(ans) = zero; + if (hx < 0 && ix < hiinf && iu < hiinf) { + /* -x ** u is exp(i*pi*u)*pow(x,u) */ + t = powf(-x, u); + sincospif(u, &s, &c); + F_RE(ans) = (c == zero)? c: c * t; + F_IM(ans) = (s == zero)? s: s * t; + } else { + F_RE(ans) = powf(x, u); + } + } else if (ix == 0 || ix >= hiinf || iy >= hiinf) { + if (ix > hiinf || iy > hiinf || iu > hiinf) { + F_RE(ans) = F_IM(ans) = x + y + u; + } else { + v = fabsf(y); + if (ix != 0) + v += fabsf(x); + t = atan2pif(y, x); + sincospif(t * u, &s, &c); + F_RE(ans) = (c == zero)? c: c * v; + F_IM(ans) = (s == zero)? s: s * v; + } + } else if (ix == iy) { /* if |x| == |y| */ +#if defined(__i386) && !defined(__amd64) + int rp = __swapRP(fp_extended); +#endif + dx = (double)x; + du = (double)u; + dt = (hx >= 0)? 0.25 : 0.75; + if (hy < 0) + dt = -dt; + dr = pow(dsqrt2 * dx, du); + sincospi(dt * du, &ds, &dc); + F_RE(ans) = (float)(dr * dc); + F_IM(ans) = (float)(dr * ds); +#if defined(__i386) && !defined(__amd64) + if (rp != fp_extended) + (void) __swapRP(rp); +#endif + } else { + j = 1; + } + if (j == 0) + return (ans); + } + if (iu >= hiinf || iv >= hiinf || ix >= hiinf || iy >= hiinf) { + /* + * non-zero imaginery part(s) with inf component(s) yields NaN + */ + t = fabsf(x) + fabsf(y) + fabsf(u) + fabsf(v); + F_RE(ans) = F_IM(ans) = t - t; + } else { +#if defined(__i386) && !defined(__amd64) + int rp = __swapRP(fp_extended); +#endif + /* INDENT OFF */ + /* + * r = u*log(hypot(x,y))-v*atan2(y,x), + * q = u*atan2(y,x)+v*log(hypot(x,y)) + * or + * r = u*log(hypot(x,y))-v*pi*atan2pi(y,x), + * q/pi = u*atan2pi(y,x)+v*log(hypot(x,y))/pi + * ans = exp(r)*(cospi(q/pi) + i sinpi(q/pi)) + */ + /* INDENT ON */ + dx = (double)x; + dy = (double)y; + du = (double)u; + dv = (double)v; + if (ix > 0x3f000000 && ix < 0x40000000) /* .5 < |x| < 2 */ + dt = dhalf * log1p((dx - 1.0) * (dx + 1.0) + dy * dy); + else if (iy > 0x3f000000 && iy < 0x40000000) /* .5 < |y| < 2 */ + dt = dhalf * log1p((dy - 1.0) * (dy + 1.0) + dx * dx); + else + dt = dhalf * log(dx * dx + dy * dy); + dp = atan2pi(dy, dx); + if (iv == 0) { /* dv = 0 */ + dr = exp(du * dt); + dq = du * dp; + } else { + dr = exp(du * dt - dv * dp * dpi); + dq = du * dp + dv * dt * dinvpi; + } + sincospi(dq, &ds, &dc); + F_RE(ans) = (float)(dr * dc); + F_IM(ans) = (float)(dr * ds); +#if defined(__i386) && !defined(__amd64) + if (rp != fp_extended) + (void) __swapRP(rp); +#endif + } + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/cpowl.c b/usr/src/lib/libm/common/complex/cpowl.c new file mode 100644 index 0000000000..091155d452 --- /dev/null +++ b/usr/src/lib/libm/common/complex/cpowl.c @@ -0,0 +1,280 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cpowl = __cpowl + +#include "libm.h" /* __k_clog_rl/__k_atan2l */ +/* atan2l/atan2pil/exp2l/expl/fabsl/hypotl/isinfl/logl/powl/sincosl/sincospil */ +#include "complex_wrapper.h" +#include "longdouble.h" + +#if defined(__sparc) +#define HALF(x) ((int *) &x)[3] = 0; ((int *) &x)[2] &= 0xfe000000 +#define LAST(x) ((int *) &x)[3] +#elif defined(__x86) +#define HALF(x) ((int *) &x)[0] = 0 +#define LAST(x) ((int *) &x)[0] +#endif + +/* INDENT OFF */ +static const int hiinf = 0x7fff0000; +static const long double + tiny = 1.0e-4000L, + huge = 1.0e4000L, +#if defined(__x86) + /* 43 significant bits, 21 trailing zeros */ + ln2hil = 0.693147180559890330187045037746429443359375L, + ln2lol = 5.497923018708371174712471612513436025525412068e-14L, +#else /* sparc */ + /* 0x3FF962E4 2FEFA39E F35793C7 00000000 */ + ln2hil = 0.693147180559945309417231592858066493070671489074L, + ln2lol = 5.28600110075004828645286235820646730106802446566153e-25L, +#endif + invln2 = 1.442695040888963407359924681001892137427e+0000L, + one = 1.0L, + zero = 0.0L; +/* INDENT ON */ + +/* + * Assuming |t[0]| > |t[1]| and |t[2]| > |t[3]|, sum4fpl subroutine + * compute t[0] + t[1] + t[2] + t[3] into two long double fp numbers. + */ +static long double sum4fpl(long double ta[], long double *w) +{ + long double t1, t2, t3, t4, w1, w2, t; + t1 = ta[0]; t2 = ta[1]; t3 = ta[2]; t4 = ta[3]; + /* + * Rearrange ti so that |t1| >= |t2| >= |t3| >= |t4| + */ + if (fabsl(t4) > fabsl(t1)) { + t = t1; t1 = t3; t3 = t; + t = t2; t2 = t4; t4 = t; + } else if (fabsl(t3) > fabsl(t1)) { + t = t1; t1 = t3; + if (fabsl(t4) > fabsl(t2)) { + t3 = t4; t4 = t2; t2 = t; + } else { + t3 = t2; t2 = t; + } + } else if (fabsl(t3) > fabsl(t2)) { + t = t2; t2 = t3; + if (fabsl(t4) > fabsl(t2)) { + t3 = t4; t4 = t; + } else + t3 = t; + } + /* summing r = t1 + t2 + t3 + t4 to w1 + w2 */ + w1 = t3 + t4; + w2 = t4 - (w1 - t3); + t = t2 + w1; + w2 += w1 - (t - t2); + w1 = t + w2; + w2 += t - w1; + t = t1 + w1; + w2 += w1 - (t - t1); + w1 = t + w2; + *w = w2 - (w1 - t); + return (w1); +} + +ldcomplex +cpowl(ldcomplex z, ldcomplex w) { + ldcomplex ans; + long double x, y, u, v, t, c, s, r; + long double t1, t2, t3, t4, x1, x2, y1, y2, u1, v1, b[4], w1, w2; + int ix, iy, hx, hy, hv, hu, iu, iv, i, j, k; + + x = LD_RE(z); + y = LD_IM(z); + u = LD_RE(w); + v = LD_IM(w); + hx = HI_XWORD(x); + hy = HI_XWORD(y); + hu = HI_XWORD(u); + hv = HI_XWORD(v); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + iu = hu & 0x7fffffff; + iv = hv & 0x7fffffff; + + j = 0; + if (v == zero) { /* z**(real) */ + if (u == one) { /* (anything) ** 1 is itself */ + LD_RE(ans) = x; + LD_IM(ans) = y; + } else if (u == zero) { /* (anything) ** 0 is 1 */ + LD_RE(ans) = one; + LD_IM(ans) = zero; + } else if (y == zero) { /* real ** real */ + LD_IM(ans) = zero; + if (hx < 0 && ix < hiinf && iu < hiinf) { + /* -x ** u is exp(i*pi*u)*pow(x,u) */ + r = powl(-x, u); + sincospil(u, &s, &c); + LD_RE(ans) = (c == zero)? c: c * r; + LD_IM(ans) = (s == zero)? s: s * r; + } else + LD_RE(ans) = powl(x, u); + } else if (x == zero || ix >= hiinf || iy >= hiinf) { + if (isnanl(x) || isnanl(y) || isnanl(u)) + LD_RE(ans) = LD_IM(ans) = x + y + u; + else { + if (x == zero) + r = fabsl(y); + else + r = fabsl(x) + fabsl(y); + t = atan2pil(y, x); + sincospil(t * u, &s, &c); + LD_RE(ans) = (c == zero)? c: c * r; + LD_IM(ans) = (s == zero)? s: s * r; + } + } else if (fabsl(x) == fabsl(y)) { /* |x| = |y| */ + if (hx >= 0) { + t = (hy >= 0)? 0.25L : -0.25L; + sincospil(t * u, &s, &c); + } else if ((LAST(u) & 3) == 0) { + t = (hy >= 0)? 0.75L : -0.75L; + sincospil(t * u, &s, &c); + } else { + r = (hy >= 0)? u : -u; + t = -0.25L * r; + w1 = r + t; + w2 = t - (w1 - r); + sincospil(w1, &t1, &t2); + sincospil(w2, &t3, &t4); + s = t1 * t4 + t3 * t2; + c = t2 * t4 - t1 * t3; + } + if (ix < 0x3ffe0000) /* |x| < 1/2 */ + r = powl(fabsl(x + x), u) * exp2l(-0.5L * u); + else if (ix >= 0x3fff0000 || iu < 0x400cfff8) + /* |x| >= 1 or |u| < 16383 */ + r = powl(fabsl(x), u) * exp2l(0.5L * u); + else /* special treatment */ + j = 2; + if (j == 0) { + LD_RE(ans) = (c == zero)? c: c * r; + LD_IM(ans) = (s == zero)? s: s * r; + } + } else + j = 1; + if (j == 0) + return (ans); + } + if (iu >= hiinf || iv >= hiinf || ix >= hiinf || iy >= hiinf) { + /* + * non-zero imag part(s) with inf component(s) yields NaN + */ + t = fabsl(x) + fabsl(y) + fabsl(u) + fabsl(v); + LD_RE(ans) = LD_IM(ans) = t - t; + } else { + k = 0; /* no scaling */ + if (iu > 0x7ffe0000 || iv > 0x7ffe0000) { + u *= 1.52587890625000000000e-05L; + v *= 1.52587890625000000000e-05L; + k = 1; /* scale u and v by 2**-16 */ + } + /* + * Use similated higher precision arithmetic to compute: + * r = u * log(hypot(x, y)) - v * atan2(y, x) + * q = u * atan2(y, x) + v * log(hypot(x, y)) + */ + + t1 = __k_clog_rl(x, y, &t2); + t3 = __k_atan2l(y, x, &t4); + x1 = t1; HALF(x1); + y1 = t3; HALF(y1); + u1 = u; HALF(u1); + v1 = v; HALF(v1); + x2 = t2 - (x1 - t1); /* log(hypot(x,y)) = x1 + x2 */ + y2 = t4 - (y1 - t3); /* atan2(y,x) = y1 + y2 */ + /* compute q = u * atan2(y, x) + v * log(hypot(x, y)) */ + if (j != 2) { + b[0] = u1 * y1; + b[1] = (u - u1) * y1 + u * y2; + if (j == 1) { /* v = 0 */ + w1 = b[0] + b[1]; + w2 = b[1] - (w1 - b[0]); + } else { + b[2] = v1 * x1; + b[3] = (v - v1) * x1 + v * x2; + w1 = sum4fpl(b, &w2); + } + sincosl(w1, &t1, &t2); + sincosl(w2, &t3, &t4); + s = t1 * t4 + t3 * t2; + c = t2 * t4 - t1 * t3; + if (k == 1) /* square j times */ + for (i = 0; i < 10; i++) { + t1 = s * c; + c = (c + s) * (c - s); + s = t1 + t1; + } + } + /* compute r = u * (t1, t2) - v * (t3, t4) */ + b[0] = u1 * x1; + b[1] = (u - u1) * x1 + u * x2; + if (j == 1) { /* v = 0 */ + w1 = b[0] + b[1]; + w2 = b[1] - (w1 - b[0]); + } else { + b[2] = -v1 * y1; + b[3] = (v1 - v) * y1 - v * y2; + w1 = sum4fpl(b, &w2); + } + /* scale back unless w1 is large enough to cause exception */ + if (k != 0 && fabsl(w1) < 20000.0L) { + w1 *= 65536.0L; w2 *= 65536.0L; + } + hx = HI_XWORD(w1); + ix = hx & 0x7fffffff; + /* compute exp(w1 + w2) */ + k = 0; + if (ix < 0x3f8c0000) /* exp(tiny < 2**-115) = 1 */ + r = one; + else if (ix >= 0x400c6760) /* overflow/underflow */ + r = (hx < 0)? tiny * tiny : huge * huge; + else { /* compute exp(w1 + w2) */ + k = (int) (invln2 * w1 + ((hx >= 0)? 0.5L : -0.5L)); + t1 = (long double) k; + t2 = w1 - t1 * ln2hil; + t3 = w2 - t1 * ln2lol; + r = expl(t2 + t3); + } + if (c != zero) c *= r; + if (s != zero) s *= r; + if (k != 0) { + c = scalbnl(c, k); + s = scalbnl(s, k); + } + LD_RE(ans) = c; + LD_IM(ans) = s; + } + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/cproj.c b/usr/src/lib/libm/common/complex/cproj.c new file mode 100644 index 0000000000..10ed9ad20a --- /dev/null +++ b/usr/src/lib/libm/common/complex/cproj.c @@ -0,0 +1,69 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cproj = __cproj + +/* INDENT OFF */ +/* + * dcomplex cproj(dcomplex z); + * + * If one of the component of z = (x,y) is an inf, then + * cproj(z) = (+inf, copysign(0,y)); + * otherwise, + * cproj(z) = z + */ +/* INDENT ON */ + +#include "libm.h" /* fabs */ +#include "complex_wrapper.h" + +static const double zero = 0.0; + +dcomplex +cproj(dcomplex z) { + double x, y; + int ix, iy, hx, hy, lx, ly; + + x = D_RE(z); + y = D_IM(z); + hx = HI_WORD(x); + lx = LO_WORD(x); + hy = HI_WORD(y); + ly = LO_WORD(y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + if (ISINF(iy, ly)) { + D_RE(z) = fabs(y); + D_IM(z) = hy >= 0 ? zero : -zero; + } else if (ISINF(ix, lx)) { + D_RE(z) = fabs(x); + D_IM(z) = hy >= 0 ? zero : -zero; + } + return (z); +} diff --git a/usr/src/lib/libm/common/complex/cprojf.c b/usr/src/lib/libm/common/complex/cprojf.c new file mode 100644 index 0000000000..53585dcde9 --- /dev/null +++ b/usr/src/lib/libm/common/complex/cprojf.c @@ -0,0 +1,58 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cprojf = __cprojf + +#include "libm.h" +#include "complex_wrapper.h" + +/* INDENT OFF */ +static const float zero = 0.0F; +/* INDENT ON */ + +fcomplex +cprojf(fcomplex z) { + float x, y; + int ix, iy, hx, hy; + + x = F_RE(z); + y = F_IM(z); + hx = THE_WORD(x); + hy = THE_WORD(y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + if (iy == 0x7f800000) { + F_RE(z) = fabsf(y); + F_IM(z) = hy >= 0 ? zero : -zero; + } else if (ix == 0x7f800000) { + F_RE(z) = fabsf(x); + F_IM(z) = hy >= 0 ? zero : -zero; + } + return (z); +} diff --git a/usr/src/lib/libm/common/complex/cprojl.c b/usr/src/lib/libm/common/complex/cprojl.c new file mode 100644 index 0000000000..76a88e2b96 --- /dev/null +++ b/usr/src/lib/libm/common/complex/cprojl.c @@ -0,0 +1,60 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak cprojl = __cprojl + +#include "libm.h" /* fabsl */ +#include "complex_wrapper.h" +#include "longdouble.h" + +/* INDENT OFF */ +static const long double zero = 0.0L; +/* INDENT ON */ + +ldcomplex +cprojl(ldcomplex z) { + long double x, y; + int hy; + + x = LD_RE(z); + y = LD_IM(z); +#if defined(__x86) + hy = ((int *) &y)[2] << 16; +#else + hy = ((int *) &y)[0]; +#endif + if (isinfl(y)) { + LD_RE(z) = fabsl(y); + LD_IM(z) = hy >= 0 ? zero : -zero; + } else if (isinfl(x)) { + LD_RE(z) = fabsl(x); + LD_IM(z) = hy >= 0 ? zero : -zero; + } + return (z); +} diff --git a/usr/src/lib/libm/common/complex/creal.c b/usr/src/lib/libm/common/complex/creal.c new file mode 100644 index 0000000000..2cc287fe36 --- /dev/null +++ b/usr/src/lib/libm/common/complex/creal.c @@ -0,0 +1,38 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak creal = __creal + +#include "libm.h" +#include "complex_wrapper.h" + +double +creal(dcomplex z) { + return (D_RE(z)); +} diff --git a/usr/src/lib/libm/common/complex/crealf.c b/usr/src/lib/libm/common/complex/crealf.c new file mode 100644 index 0000000000..fb5fb4cb38 --- /dev/null +++ b/usr/src/lib/libm/common/complex/crealf.c @@ -0,0 +1,38 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak crealf = __crealf + +#include "libm.h" +#include "complex_wrapper.h" + +float +crealf(fcomplex z) { + return (F_RE(z)); +} diff --git a/usr/src/lib/libm/common/complex/creall.c b/usr/src/lib/libm/common/complex/creall.c new file mode 100644 index 0000000000..0b2b2f62a7 --- /dev/null +++ b/usr/src/lib/libm/common/complex/creall.c @@ -0,0 +1,38 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak creall = __creall + +#include "libm.h" +#include "complex_wrapper.h" + +long double +creall(ldcomplex z) { + return (LD_RE(z)); +} diff --git a/usr/src/lib/libm/common/complex/csin.c b/usr/src/lib/libm/common/complex/csin.c new file mode 100644 index 0000000000..3bac36288c --- /dev/null +++ b/usr/src/lib/libm/common/complex/csin.c @@ -0,0 +1,61 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak csin = __csin + +/* INDENT OFF */ +/* + * dcomplex csin(dcomplex z); + * + * If z = x+iy, then since csin(iz) = i*csinh(z), we have + * + * csin(z) = csin((-1)*(-z)) = csin(i*i*(-z)) + * = i*csinh(i*(-z)) = i*csinh(i*(-x-yi)) + * = i*csinh(y-ix) + * = -Im(csinh(y-ix))+i*Re(csinh(y-ix)) + */ +/* INDENT ON */ + +#include "libm.h" +#include "complex_wrapper.h" + +dcomplex +csin(dcomplex z) { + double x, y; + dcomplex ans, ct; + + x = D_RE(z); + y = D_IM(z); + D_RE(z) = y; + D_IM(z) = -x; + ct = csinh(z); + D_RE(ans) = -D_IM(ct); + D_IM(ans) = D_RE(ct); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/csinf.c b/usr/src/lib/libm/common/complex/csinf.c new file mode 100644 index 0000000000..6c88d0e1d1 --- /dev/null +++ b/usr/src/lib/libm/common/complex/csinf.c @@ -0,0 +1,48 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak csinf = __csinf + +#include "libm.h" +#include "complex_wrapper.h" + +fcomplex +csinf(fcomplex z) { + float x, y; + fcomplex ans, ct; + + x = F_RE(z); + y = F_IM(z); + F_RE(z) = y; + F_IM(z) = -x; + ct = csinhf(z); + F_RE(ans) = -F_IM(ct); + F_IM(ans) = F_RE(ct); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/csinh.c b/usr/src/lib/libm/common/complex/csinh.c new file mode 100644 index 0000000000..4bca7f6ade --- /dev/null +++ b/usr/src/lib/libm/common/complex/csinh.c @@ -0,0 +1,137 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak csinh = __csinh + +/* INDENT OFF */ +/* + * dcomplex csinh(dcomplex z); + * + * z -z x -x + * e - e e (cos(y)+i*sin(y)) - e (cos(-y)+i*sin(-y)) + * sinh z = -------------- = --------------------------------------------- + * 2 2 + * x -x x -x + * cos(y) ( e - e ) + i*sin(y) (e + e ) + * = -------------------------------------------- + * 2 + * + * = cos(y) sinh(x) + i sin(y) cosh(x) + * + * Implementation Note + * ------------------- + * + * |x| -|x| |x| -2|x| -2|x| -P-4 + * Note that e +- e = e ( 1 +- e ). If e < 2 , where + * + * P stands for the number of significant bits of the machine precision, + * |x| + * then the result will be rounded to e . Therefore, we have + * + * z + * e + * sinh z = ----- if |x| >= (P/2 + 2)*ln2 + * 2 + * + * EXCEPTION (conform to ISO/IEC 9899:1999(E)): + * csinh(0,0)=(0,0) + * csinh(0,inf)=(+-0,NaN) + * csinh(0,NaN)=(+-0,NaN) + * csinh(x,inf) = (NaN,NaN) for finite positive x + * csinh(x,NaN) = (NaN,NaN) for finite non-zero x + * csinh(inf,0) = (inf, 0) + * csinh(inf,y) = (inf*cos(y),inf*sin(y)) for positive finite y + * csinh(inf,inf) = (+-inf,NaN) + * csinh(inf,NaN) = (+-inf,NaN) + * csinh(NaN,0) = (NaN,0) + * csinh(NaN,y) = (NaN,NaN) for non-zero y + * csinh(NaN,NaN) = (NaN,NaN) + */ +/* INDENT ON */ + +#include "libm.h" /* cosh/exp/fabs/scalbn/sinh/sincos/__k_cexp */ +#include "complex_wrapper.h" + +dcomplex +csinh(dcomplex z) { + double t, x, y, S, C; + int hx, ix, lx, hy, iy, ly, n; + dcomplex ans; + + x = D_RE(z); + y = D_IM(z); + hx = HI_WORD(x); + lx = LO_WORD(x); + ix = hx & 0x7fffffff; + hy = HI_WORD(y); + ly = LO_WORD(y); + iy = hy & 0x7fffffff; + x = fabs(x); + y = fabs(y); + + (void) sincos(y, &S, &C); + if (ix >= 0x403c0000) { /* |x| > 28 = prec/2 (14,28,34,60) */ + if (ix >= 0x40862E42) { /* |x| > 709.78... ~ log(2**1024) */ + if (ix >= 0x7ff00000) { /* |x| is inf or NaN */ + if ((iy | ly) == 0) { + D_RE(ans) = x; + D_IM(ans) = y; + } else if (iy >= 0x7ff00000) { + D_RE(ans) = x; + D_IM(ans) = x - y; + } else { + D_RE(ans) = C * x; + D_IM(ans) = S * x; + } + } else { + /* return exp(x)=t*2**n */ + t = __k_cexp(x, &n); + D_RE(ans) = scalbn(C * t, n - 1); + D_IM(ans) = scalbn(S * t, n - 1); + } + } else { + t = exp(x) * 0.5; + D_RE(ans) = C * t; + D_IM(ans) = S * t; + } + } else { + if ((ix | lx) == 0) { /* x = 0, return (0,S) */ + D_RE(ans) = 0.0; + D_IM(ans) = S; + } else { + D_RE(ans) = C * sinh(x); + D_IM(ans) = S * cosh(x); + } + } + if (hx < 0) + D_RE(ans) = -D_RE(ans); + if (hy < 0) + D_IM(ans) = -D_IM(ans); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/csinhf.c b/usr/src/lib/libm/common/complex/csinhf.c new file mode 100644 index 0000000000..0ef3012b7c --- /dev/null +++ b/usr/src/lib/libm/common/complex/csinhf.c @@ -0,0 +1,102 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2005 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak csinhf = __csinhf + +#include "libm.h" +#include "complex_wrapper.h" + +#if defined(__i386) && !defined(__amd64) +extern int __swapRP(int); +#endif + +static const float zero = 0.0F, half = 0.5F; + +fcomplex +csinhf(fcomplex z) { + float x, y, S, C; + double t; + int hx, ix, hy, iy, n; + fcomplex ans; + + x = F_RE(z); + y = F_IM(z); + hx = THE_WORD(x); + ix = hx & 0x7fffffff; + hy = THE_WORD(y); + iy = hy & 0x7fffffff; + x = fabsf(x); + y = fabsf(y); + + sincosf(y, &S, &C); + if (ix >= 0x41600000) { /* |x| > 14 = prec/2 (14,28,34,60) */ + if (ix >= 0x42B171AA) { /* |x| > 88.722... ~ log(2**128) */ + if (ix >= 0x7f800000) { /* |x| is inf or NaN */ + if (iy == 0) { + F_RE(ans) = x; + F_IM(ans) = y; + } else if (iy >= 0x7f800000) { + F_RE(ans) = x; + F_IM(ans) = x - y; + } else { + F_RE(ans) = C * x; + F_IM(ans) = S * x; + } + } else { +#if defined(__i386) && !defined(__amd64) + int rp = __swapRP(fp_extended); +#endif + /* return (C, S) * exp(x) / 2 */ + t = __k_cexp((double)x, &n); + F_RE(ans) = (float)scalbn(C * t, n - 1); + F_IM(ans) = (float)scalbn(S * t, n - 1); +#if defined(__i386) && !defined(__amd64) + if (rp != fp_extended) + (void) __swapRP(rp); +#endif + } + } else { + t = expf(x) * half; + F_RE(ans) = C * t; + F_IM(ans) = S * t; + } + } else { + if (ix == 0) { /* x = 0, return (0,S) */ + F_RE(ans) = zero; + F_IM(ans) = S; + } else { + F_RE(ans) = C * sinhf(x); + F_IM(ans) = S * coshf(x); + } + } + if (hx < 0) + F_RE(ans) = -F_RE(ans); + if (hy < 0) + F_IM(ans) = -F_IM(ans); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/csinhl.c b/usr/src/lib/libm/common/complex/csinhl.c new file mode 100644 index 0000000000..1660a9c022 --- /dev/null +++ b/usr/src/lib/libm/common/complex/csinhl.c @@ -0,0 +1,93 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak csinhl = __csinhl + +#include "libm.h" /* coshl/expl/fabsl/scalbnl/sincosl/sinhl/__k_cexpl */ +#include "complex_wrapper.h" + +/* INDENT OFF */ +static const long double zero = 0.0L, half = 0.5L; +/* INDENT ON */ + +ldcomplex +csinhl(ldcomplex z) { + long double t, x, y, S, C; + int hx, ix, hy, iy, n; + ldcomplex ans; + + x = LD_RE(z); + y = LD_IM(z); + hx = HI_XWORD(x); + ix = hx & 0x7fffffff; + hy = HI_XWORD(y); + iy = hy & 0x7fffffff; + x = fabsl(x); + y = fabsl(y); + + (void) sincosl(y, &S, &C); + if (ix >= 0x4004e000) { /* |x| > 60 = prec/2 (14,28,34,60) */ + if (ix >= 0x400C62E4) { /* |x| > 11356.52... ~ log(2**16384) */ + if (ix >= 0x7fff0000) { /* |x| is inf or NaN */ + if (y == zero) { + LD_RE(ans) = x; + LD_IM(ans) = y; + } else if (iy >= 0x7fff0000) { + LD_RE(ans) = x; + LD_IM(ans) = x - y; + } else { + LD_RE(ans) = C * x; + LD_IM(ans) = S * x; + } + } else { + /* return exp(x)=t*2**n */ + t = __k_cexpl(x, &n); + LD_RE(ans) = scalbnl(C * t, n - 1); + LD_IM(ans) = scalbnl(S * t, n - 1); + } + } else { + t = expl(x) * half; + LD_RE(ans) = C * t; + LD_IM(ans) = S * t; + } + } else { + if (x == zero) { /* x = 0, return (0,S) */ + LD_RE(ans) = zero; + LD_IM(ans) = S; + } else { + LD_RE(ans) = C * sinhl(x); + LD_IM(ans) = S * coshl(x); + } + } + if (hx < 0) + LD_RE(ans) = -LD_RE(ans); + if (hy < 0) + LD_IM(ans) = -LD_IM(ans); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/csinl.c b/usr/src/lib/libm/common/complex/csinl.c new file mode 100644 index 0000000000..d5ec9a5661 --- /dev/null +++ b/usr/src/lib/libm/common/complex/csinl.c @@ -0,0 +1,48 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak csinl = __csinl + +#include "libm.h" +#include "complex_wrapper.h" + +ldcomplex +csinl(ldcomplex z) { + long double x, y; + ldcomplex ans, ct; + + x = LD_RE(z); + y = LD_IM(z); + LD_RE(z) = y; + LD_IM(z) = -x; + ct = csinhl(z); + LD_RE(ans) = -LD_IM(ct); + LD_IM(ans) = LD_RE(ct); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/csqrt.c b/usr/src/lib/libm/common/complex/csqrt.c new file mode 100644 index 0000000000..1a00236677 --- /dev/null +++ b/usr/src/lib/libm/common/complex/csqrt.c @@ -0,0 +1,210 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak csqrt = __csqrt + +/* INDENT OFF */ +/* + * dcomplex csqrt(dcomplex z); + * + * 2 2 2 + * Let w=r+i*s = sqrt(x+iy). Then (r + i s) = r - s + i 2sr = x + i y. + * + * Hence x = r*r-s*s, y = 2sr. + * + * Note that x*x+y*y = (s*s+r*r)**2. Thus, we have + * ________ + * 2 2 / 2 2 + * (1) r + s = \/ x + y , + * + * 2 2 + * (2) r - s = x + * + * (3) 2sr = y. + * + * Perform (1)-(2) and (1)+(2), we obtain + * + * 2 + * (4) 2 r = hypot(x,y)+x, + * + * 2 + * (5) 2*s = hypot(x,y)-x + * ________ + * / 2 2 + * where hypot(x,y) = \/ x + y . + * + * In order to avoid numerical cancellation, we use formula (4) for + * positive x, and (5) for negative x. The other component is then + * computed by formula (3). + * + * + * ALGORITHM + * ------------------ + * + * (assume x and y are of medium size, i.e., no over/underflow in squaring) + * + * If x >=0 then + * ________ + * / 2 2 + * 2 \/ x + y + x y + * r = ---------------------, s = -------; (6) + * 2 2 r + * + * (note that we choose sign(s) = sign(y) to force r >=0). + * Otherwise, + * ________ + * / 2 2 + * 2 \/ x + y - x y + * s = ---------------------, r = -------; (7) + * 2 2 s + * + * EXCEPTION: + * + * One may use the polar coordinate of a complex number to justify the + * following exception cases: + * + * EXCEPTION CASES (conform to ISO/IEC 9899:1999(E)): + * csqrt(+-0+ i 0 ) = 0 + i 0 + * csqrt( x + i inf ) = inf + i inf for all x (including NaN) + * csqrt( x + i NaN ) = NaN + i NaN with invalid for finite x + * csqrt(-inf+ iy ) = 0 + i inf for finite positive-signed y + * csqrt(+inf+ iy ) = inf + i 0 for finite positive-signed y + * csqrt(-inf+ i NaN) = NaN +-i inf + * csqrt(+inf+ i NaN) = inf + i NaN + * csqrt(NaN + i y ) = NaN + i NaN for finite y + * csqrt(NaN + i NaN) = NaN + i NaN + */ +/* INDENT ON */ + +#include "libm.h" /* fabs/sqrt */ +#include "complex_wrapper.h" + +/* INDENT OFF */ +static const double + two300 = 2.03703597633448608627e+90, + twom300 = 4.90909346529772655310e-91, + two599 = 2.07475778444049647926e+180, + twom601 = 1.20495993255144205887e-181, + two = 2.0, + zero = 0.0, + half = 0.5; +/* INDENT ON */ + +dcomplex +csqrt(dcomplex z) { + dcomplex ans; + double x, y, t, ax, ay; + int n, ix, iy, hx, hy, lx, ly; + + x = D_RE(z); + y = D_IM(z); + hx = HI_WORD(x); + lx = LO_WORD(x); + hy = HI_WORD(y); + ly = LO_WORD(y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + ay = fabs(y); + ax = fabs(x); + if (ix >= 0x7ff00000 || iy >= 0x7ff00000) { + /* x or y is Inf or NaN */ + if (ISINF(iy, ly)) + D_IM(ans) = D_RE(ans) = ay; + else if (ISINF(ix, lx)) { + if (hx > 0) { + D_RE(ans) = ax; + D_IM(ans) = ay * zero; + } else { + D_RE(ans) = ay * zero; + D_IM(ans) = ax; + } + } else + D_IM(ans) = D_RE(ans) = ax + ay; + } else if ((iy | ly) == 0) { /* y = 0 */ + if (hx >= 0) { + D_RE(ans) = sqrt(ax); + D_IM(ans) = zero; + } else { + D_IM(ans) = sqrt(ax); + D_RE(ans) = zero; + } + } else if (ix >= iy) { + n = (ix - iy) >> 20; + if (n >= 30) { /* x >> y or y=0 */ + t = sqrt(ax); + } else if (ix >= 0x5f300000) { /* x > 2**500 */ + ax *= twom601; + y *= twom601; + t = two300 * sqrt(ax + sqrt(ax * ax + y * y)); + } else if (iy < 0x20b00000) { /* y < 2**-500 */ + ax *= two599; + y *= two599; + t = twom300 * sqrt(ax + sqrt(ax * ax + y * y)); + } else + t = sqrt(half * (ax + sqrt(ax * ax + ay * ay))); + if (hx >= 0) { + D_RE(ans) = t; + D_IM(ans) = ay / (t + t); + } else { + D_IM(ans) = t; + D_RE(ans) = ay / (t + t); + } + } else { + n = (iy - ix) >> 20; + if (n >= 30) { /* y >> x */ + if (n >= 60) + t = sqrt(half * ay); + else if (iy >= 0x7fe00000) + t = sqrt(half * ay + half * ax); + else if (ix <= 0x00100000) + t = half * sqrt(two * (ay + ax)); + else + t = sqrt(half * (ay + ax)); + } else if (iy >= 0x5f300000) { /* y > 2**500 */ + ax *= twom601; + y *= twom601; + t = two300 * sqrt(ax + sqrt(ax * ax + y * y)); + } else if (ix < 0x20b00000) { /* x < 2**-500 */ + ax *= two599; + y *= two599; + t = twom300 * sqrt(ax + sqrt(ax * ax + y * y)); + } else + t = sqrt(half * (ax + sqrt(ax * ax + ay * ay))); + if (hx >= 0) { + D_RE(ans) = t; + D_IM(ans) = ay / (t + t); + } else { + D_IM(ans) = t; + D_RE(ans) = ay / (t + t); + } + } + if (hy < 0) + D_IM(ans) = -D_IM(ans); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/csqrtf.c b/usr/src/lib/libm/common/complex/csqrtf.c new file mode 100644 index 0000000000..b0fef11d0f --- /dev/null +++ b/usr/src/lib/libm/common/complex/csqrtf.c @@ -0,0 +1,93 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak csqrtf = __csqrtf + +#include "libm.h" /* sqrt/fabsf/sqrtf */ +#include "complex_wrapper.h" + +/* INDENT OFF */ +static const float zero = 0.0F; +/* INDENT ON */ + +fcomplex +csqrtf(fcomplex z) { + fcomplex ans; + double dt, dx, dy; + float x, y, t, ax, ay, w; + int ix, iy, hx, hy; + + x = F_RE(z); + y = F_IM(z); + hx = THE_WORD(x); + hy = THE_WORD(y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + ay = fabsf(y); + ax = fabsf(x); + if (ix >= 0x7f800000 || iy >= 0x7f800000) { + /* x or y is Inf or NaN */ + if (iy == 0x7f800000) + F_IM(ans) = F_RE(ans) = ay; + else if (ix == 0x7f800000) { + if (hx > 0) { + F_RE(ans) = ax; + F_IM(ans) = ay * zero; + } else { + F_RE(ans) = ay * zero; + F_IM(ans) = ax; + } + } else + F_IM(ans) = F_RE(ans) = ax + ay; + } else if (iy == 0) { + if (hx >= 0) { + F_RE(ans) = sqrtf(ax); + F_IM(ans) = zero; + } else { + F_IM(ans) = sqrtf(ax); + F_RE(ans) = zero; + } + } else { + dx = (double) ax; + dy = (double) ay; + dt = sqrt(0.5 * (sqrt(dx * dx + dy * dy) + dx)); + t = (float) dt; + w = (float) (dy / (dt + dt)); + if (hx >= 0) { + F_RE(ans) = t; + F_IM(ans) = w; + } else { + F_IM(ans) = t; + F_RE(ans) = w; + } + } + if (hy < 0) + F_IM(ans) = -F_IM(ans); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/csqrtl.c b/usr/src/lib/libm/common/complex/csqrtl.c new file mode 100644 index 0000000000..6bd8bccf4d --- /dev/null +++ b/usr/src/lib/libm/common/complex/csqrtl.c @@ -0,0 +1,146 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak csqrtl = __csqrtl + +#include "libm.h" /* fabsl/isinfl/sqrtl */ +#include "complex_wrapper.h" +#include "longdouble.h" + +/* INDENT OFF */ +static const long double + twom9001 = 2.6854002716003034957421765100615693043656e-2710L, + twom4500 = 2.3174987687592429423263242862381544149252e-1355L, + two8999 = 9.3095991180122343502582347372163290310934e+2708L, + two4500 = 4.3149968987270974283777803545571722250806e+1354L, + zero = 0.0L, + half = 0.5L, + two = 2.0L; +/* INDENT ON */ + +ldcomplex +csqrtl(ldcomplex z) { + ldcomplex ans; + long double x, y, t, ax, ay; + int n, ix, iy, hx, hy; + + x = LD_RE(z); + y = LD_IM(z); + hx = HI_XWORD(x); + hy = HI_XWORD(y); + ix = hx & 0x7fffffff; + iy = hy & 0x7fffffff; + ay = fabsl(y); + ax = fabsl(x); + if (ix >= 0x7fff0000 || iy >= 0x7fff0000) { + /* x or y is Inf or NaN */ + if (isinfl(y)) + LD_IM(ans) = LD_RE(ans) = ay; + else if (isinfl(x)) { + if (hx > 0) { + LD_RE(ans) = ax; + LD_IM(ans) = ay * zero; + } else { + LD_RE(ans) = ay * zero; + LD_IM(ans) = ax; + } + } else + LD_IM(ans) = LD_RE(ans) = ax + ay; + } else if (y == zero) { + if (hx >= 0) { + LD_RE(ans) = sqrtl(ax); + LD_IM(ans) = zero; + } else { + LD_IM(ans) = sqrtl(ax); + LD_RE(ans) = zero; + } + } else if (ix >= iy) { + n = (ix - iy) >> 16; +#if defined(__x86) /* 64 significant bits */ + if (n >= 35) +#else /* 113 significant bits */ + if (n >= 60) +#endif + t = sqrtl(ax); + else if (ix >= 0x5f3f0000) { /* x > 2**8000 */ + ax *= twom9001; + y *= twom9001; + t = two4500 * sqrtl(ax + sqrtl(ax * ax + y * y)); + } else if (iy <= 0x20bf0000) { /* y < 2**-8000 */ + ax *= two8999; + y *= two8999; + t = twom4500 * sqrtl(ax + sqrtl(ax * ax + y * y)); + } else + t = sqrtl(half * (ax + sqrtl(ax * ax + y * y))); + + if (hx >= 0) { + LD_RE(ans) = t; + LD_IM(ans) = ay / (t + t); + } else { + LD_IM(ans) = t; + LD_RE(ans) = ay / (t + t); + } + } else { + n = (iy - ix) >> 16; +#if defined(__x86) /* 64 significant bits */ + if (n >= 35) { /* } */ +#else /* 113 significant bits */ + if (n >= 60) { +#endif + if (n >= 120) + t = sqrtl(half * ay); + else if (iy >= 0x7ffe0000) + t = sqrtl(half * ay + half * ax); + else if (ix <= 0x00010000) + t = half * (sqrtl(two * (ax + ay))); + else + t = sqrtl(half * (ax + ay)); + } else if (iy >= 0x5f3f0000) { /* y > 2**8000 */ + ax *= twom9001; + y *= twom9001; + t = two4500 * sqrtl(ax + sqrtl(ax * ax + y * y)); + } else if (ix <= 0x20bf0000) { + ax *= two8999; + y *= two8999; + t = twom4500 * sqrtl(ax + sqrtl(ax * ax + y * y)); + } else + t = sqrtl(half * (ax + sqrtl(ax * ax + y * y))); + + if (hx >= 0) { + LD_RE(ans) = t; + LD_IM(ans) = ay / (t + t); + } else { + LD_IM(ans) = t; + LD_RE(ans) = ay / (t + t); + } + } + if (hy < 0) + LD_IM(ans) = -LD_IM(ans); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/ctan.c b/usr/src/lib/libm/common/complex/ctan.c new file mode 100644 index 0000000000..c9d5765853 --- /dev/null +++ b/usr/src/lib/libm/common/complex/ctan.c @@ -0,0 +1,61 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak ctan = __ctan + +/* INDENT OFF */ +/* + * dcomplex ctan(dcomplex z); + * + * If z = x+iy, then since ctan(iz) = i*ctanh(z), we have + * + * ctan(z) = ctan((-1)*(-z)) = ctan(i*i*(-z)) + * = i*ctanh(i*(-z)) = i*ctanh(i*(-x-yi)) + * = i*ctanh(y-ix) + * = -Im(ctanh(y-ix))+i*Re(ctanh(y-ix)) + */ +/* INDENT ON */ + +#include "libm.h" +#include "complex_wrapper.h" + +dcomplex +ctan(dcomplex z) { + double x, y; + dcomplex ans, ct; + + x = D_RE(z); + y = D_IM(z); + D_RE(z) = y; + D_IM(z) = -x; + ct = ctanh(z); + D_RE(ans) = -D_IM(ct); + D_IM(ans) = D_RE(ct); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/ctanf.c b/usr/src/lib/libm/common/complex/ctanf.c new file mode 100644 index 0000000000..fde6c0bbee --- /dev/null +++ b/usr/src/lib/libm/common/complex/ctanf.c @@ -0,0 +1,48 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak ctanf = __ctanf + +#include "libm.h" +#include "complex_wrapper.h" + +fcomplex +ctanf(fcomplex z) { + float x, y; + fcomplex ans, ct; + + x = F_RE(z); + y = F_IM(z); + F_RE(z) = y; + F_IM(z) = -x; + ct = ctanhf(z); + F_RE(ans) = -F_IM(ct); + F_IM(ans) = F_RE(ct); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/ctanh.c b/usr/src/lib/libm/common/complex/ctanh.c new file mode 100644 index 0000000000..1e5ecb833f --- /dev/null +++ b/usr/src/lib/libm/common/complex/ctanh.c @@ -0,0 +1,176 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak ctanh = __ctanh + +/* INDENT OFF */ +/* + * dcomplex ctanh(dcomplex z); + * + * tanh x + i tan y sinh 2x + i sin 2y + * ctanh z = --------------------- = -------------------- + * 1 + i tanh(x)tan(y) cosh 2x + cos 2y + * + * For |x| >= prec/2 (14,28,34,60 for single, double, double extended, quad), + * we use + * + * 1 2x 2 sin 2y + * cosh 2x = sinh 2x = --- e and hence ctanh z = 1 + i -----------; + * 2 2x + * e + * + * otherwise, to avoid cancellation, for |x| < prec/2, + * 2x 2 + * (e - 1) 2 2 + * cosh 2x + cos 2y = 1 + ------------ + cos y - sin y + * 2x + * 2 e + * + * 1 2x 2 -2x 2 + * = --- (e - 1) e + 2 cos y + * 2 + * and + * + * [ 2x ] + * 1 [ 2x e - 1 ] + * sinh 2x = --- [ e - 1 + --------- ] + * 2 [ 2x ] + * [ e ] + * 2x + * Implementation notes: let t = expm1(2x) = e - 1, then + * + * 1 [ t*t 2 ] 1 [ t ] + * cosh 2x + cos 2y = --- * [ ----- + 4 cos y ]; sinh 2x = --- * [ t + --- ] + * 2 [ t+1 ] 2 [ t+1 ] + * + * Hence, + * + * + * t*t+2t [4(t+1)(cos y)]*(sin y) + * ctanh z = --------------------------- + i -------------------------- + * t*t+[4(t+1)(cos y)](cos y) t*t+[4(t+1)(cos y)](cos y) + * + * EXCEPTION (conform to ISO/IEC 9899:1999(E)): + * ctanh(0,0)=(0,0) + * ctanh(x,inf) = (NaN,NaN) for finite x + * ctanh(x,NaN) = (NaN,NaN) for finite x + * ctanh(inf,y) = 1+ i*0*sin(2y) for positive-signed finite y + * ctanh(inf,inf) = (1, +-0) + * ctanh(inf,NaN) = (1, +-0) + * ctanh(NaN,0) = (NaN,0) + * ctanh(NaN,y) = (NaN,NaN) for non-zero y + * ctanh(NaN,NaN) = (NaN,NaN) + */ +/* INDENT ON */ + +#include "libm.h" /* exp/expm1/fabs/sin/tanh/sincos */ +#include "complex_wrapper.h" + +static const double four = 4.0, two = 2.0, one = 1.0, zero = 0.0; + +dcomplex +ctanh(dcomplex z) { + double t, r, v, u, x, y, S, C; + int hx, ix, lx, hy, iy, ly; + dcomplex ans; + + x = D_RE(z); + y = D_IM(z); + hx = HI_WORD(x); + lx = LO_WORD(x); + ix = hx & 0x7fffffff; + hy = HI_WORD(y); + ly = LO_WORD(y); + iy = hy & 0x7fffffff; + x = fabs(x); + y = fabs(y); + + if ((iy | ly) == 0) { /* ctanh(x,0) = (x,0) for x = 0 or NaN */ + D_RE(ans) = tanh(x); + D_IM(ans) = zero; + } else if (iy >= 0x7ff00000) { /* y is inf or NaN */ + if (ix < 0x7ff00000) /* catanh(finite x,inf/nan) is nan */ + D_RE(ans) = D_IM(ans) = y - y; + else if (((ix - 0x7ff00000) | lx) == 0) { /* x is inf */ + D_RE(ans) = one; + D_IM(ans) = zero; + } else { + D_RE(ans) = x + y; + D_IM(ans) = y - y; + } + } else if (ix >= 0x403c0000) { + /* + * |x| > 28 = prec/2 (14,28,34,60) + * ctanh z ~ 1 + i (sin2y)/(exp(2x)) + */ + D_RE(ans) = one; + if (iy < 0x7fe00000) /* t = sin(2y) */ + S = sin(y + y); + else { + (void) sincos(y, &S, &C); + S = (S + S) * C; + } + if (ix >= 0x7fe00000) { /* |x| > max/2 */ + if (ix >= 0x7ff00000) { /* |x| is inf or NaN */ + if (((ix - 0x7ff00000) | lx) != 0) + D_RE(ans) = D_IM(ans) = x + y; + /* x is NaN */ + else + D_IM(ans) = zero * S; /* x is inf */ + } else + D_IM(ans) = S * exp(-x); /* underflow */ + } else + D_IM(ans) = (S + S) * exp(-(x + x)); + /* 2 sin 2y / exp(2x) */ + } else { + /* INDENT OFF */ + /* + * t*t+2t + * ctanh z = --------------------------- + + * t*t+[4(t+1)(cos y)](cos y) + * + * [4(t+1)(cos y)]*(sin y) + * i -------------------------- + * t*t+[4(t+1)(cos y)](cos y) + */ + /* INDENT ON */ + (void) sincos(y, &S, &C); + t = expm1(x + x); + r = (four * C) * (t + one); + u = t * t; + v = one / (u + r * C); + D_RE(ans) = (u + two * t) * v; + D_IM(ans) = (r * S) * v; + } + if (hx < 0) + D_RE(ans) = -D_RE(ans); + if (hy < 0) + D_IM(ans) = -D_IM(ans); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/ctanhf.c b/usr/src/lib/libm/common/complex/ctanhf.c new file mode 100644 index 0000000000..ab67e2dd40 --- /dev/null +++ b/usr/src/lib/libm/common/complex/ctanhf.c @@ -0,0 +1,115 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak ctanhf = __ctanhf + +#include "libm.h" /* expf/expm1f/fabsf/sincosf/sinf/tanhf */ +#include "complex_wrapper.h" + +/* INDENT OFF */ +static const float four = 4.0F, two = 2.0F, one = 1.0F, zero = 0.0F; +/* INDENT ON */ + +fcomplex +ctanhf(fcomplex z) { + float r, u, v, t, x, y, S, C; + int hx, ix, hy, iy; + fcomplex ans; + + x = F_RE(z); + y = F_IM(z); + hx = THE_WORD(x); + ix = hx & 0x7fffffff; + hy = THE_WORD(y); + iy = hy & 0x7fffffff; + x = fabsf(x); + y = fabsf(y); + + if (iy == 0) { /* ctanh(x,0) = (x,0) for x = 0 or NaN */ + F_RE(ans) = tanhf(x); + F_IM(ans) = zero; + } else if (iy >= 0x7f800000) { /* y is inf or NaN */ + if (ix < 0x7f800000) /* catanh(finite x,inf/nan) is nan */ + F_RE(ans) = F_IM(ans) = y - y; + else if (ix == 0x7f800000) { /* x is inf */ + F_RE(ans) = one; + F_IM(ans) = zero; + } else { + F_RE(ans) = x + y; + F_IM(ans) = y - y; + } + } else if (ix >= 0x41600000) { + /* + * |x| > 14 = prec/2 (14,28,34,60) + * ctanh z ~ 1 + i (sin2y)/(exp(2x)) + */ + F_RE(ans) = one; + if (iy < 0x7f000000) /* t = sin(2y) */ + S = sinf(y + y); + else { + (void) sincosf(y, &S, &C); + S = (S + S) * C; + } + if (ix >= 0x7f000000) { /* |x| > max/2 */ + if (ix >= 0x7f800000) { /* |x| is inf or NaN */ + if (ix > 0x7f800000) /* x is NaN */ + F_RE(ans) = F_IM(ans) = x + y; + else + F_IM(ans) = zero * S; /* x is inf */ + } else + F_IM(ans) = S * expf(-x); /* underflow */ + } else + F_IM(ans) = (S + S) * expf(-(x + x)); + /* 2 sin 2y / exp(2x) */ + } else { + /* INDENT OFF */ + /* + * t*t+2t + * ctanh z = --------------------------- + * t*t+[4(t+1)(cos y)](cos y) + * + * [4(t+1)(cos y)]*(sin y) + * i -------------------------- + * t*t+[4(t+1)(cos y)](cos y) + */ + /* INDENT ON */ + (void) sincosf(y, &S, &C); + t = expm1f(x + x); + r = (four * C) * (t + one); + u = t * t; + v = one / (u + r * C); + F_RE(ans) = (u + two * t) * v; + F_IM(ans) = (r * S) * v; + } + if (hx < 0) + F_RE(ans) = -F_RE(ans); + if (hy < 0) + F_IM(ans) = -F_IM(ans); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/ctanhl.c b/usr/src/lib/libm/common/complex/ctanhl.c new file mode 100644 index 0000000000..c19e067f3e --- /dev/null +++ b/usr/src/lib/libm/common/complex/ctanhl.c @@ -0,0 +1,118 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak ctanhl = __ctanhl + +#include "libm.h" /* expl/expm1l/fabsl/isinfl/isnanl/sincosl/sinl/tanhl */ +#include "complex_wrapper.h" +#include "longdouble.h" + +/* INDENT OFF */ +static const long double four = 4.0L, two = 2.0L, one = 1.0L, zero = 0.0L; +/* INDENT ON */ + +ldcomplex +ctanhl(ldcomplex z) { + long double r, u, v, t, x, y, S, C; + int hx, ix, hy, iy; + ldcomplex ans; + + x = LD_RE(z); + y = LD_IM(z); + hx = HI_XWORD(x); + ix = hx & 0x7fffffff; + hy = HI_XWORD(y); + iy = hy & 0x7fffffff; + x = fabsl(x); + y = fabsl(y); + + if (y == zero) { /* ctanh(x,0) = (x,0) for x = 0 or NaN */ + LD_RE(ans) = tanhl(x); + LD_IM(ans) = zero; + } else if (iy >= 0x7fff0000) { /* y is inf or NaN */ + if (ix < 0x7fff0000) /* catanh(finite x,inf/nan) is nan */ + LD_RE(ans) = LD_IM(ans) = y - y; + else if (isinfl(x)) { /* x is inf */ + LD_RE(ans) = one; + LD_IM(ans) = zero; + } else { + LD_RE(ans) = x + y; + LD_IM(ans) = y - y; + } + } else if (ix >= 0x4004e000) { + /* INDENT OFF */ + /* + * |x| > 60 = prec/2 (14,28,34,60) + * ctanh z ~ 1 + i (sin2y)/(exp(2x)) + */ + /* INDENT ON */ + LD_RE(ans) = one; + if (iy < 0x7ffe0000) /* t = sin(2y) */ + S = sinl(y + y); + else { + (void) sincosl(y, &S, &C); + S = (S + S) * C; + } + if (ix >= 0x7ffe0000) { /* |x| > max/2 */ + if (ix >= 0x7fff0000) { /* |x| is inf or NaN */ + if (isnanl(x)) /* x is NaN */ + LD_RE(ans) = LD_IM(ans) = x + y; + else + LD_IM(ans) = zero * S; /* x is inf */ + } else + LD_IM(ans) = S * expl(-x); /* underflow */ + } else + LD_IM(ans) = (S + S) * expl(-(x + x)); + /* 2 sin 2y / exp(2x) */ + } else { + /* INDENT OFF */ + /* + * t*t+2t + * ctanh z = --------------------------- + * t*t+[4(t+1)(cos y)](cos y) + * + * [4(t+1)(cos y)]*(sin y) + * i -------------------------- + * t*t+[4(t+1)(cos y)](cos y) + */ + /* INDENT ON */ + sincosl(y, &S, &C); + t = expm1l(x + x); + r = (four * C) * (t + one); + u = t * t; + v = one / (u + r * C); + LD_RE(ans) = (u + two * t) * v; + LD_IM(ans) = (r * S) * v; + } + if (hx < 0) + LD_RE(ans) = -LD_RE(ans); + if (hy < 0) + LD_IM(ans) = -LD_IM(ans); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/ctanl.c b/usr/src/lib/libm/common/complex/ctanl.c new file mode 100644 index 0000000000..613cf4bd11 --- /dev/null +++ b/usr/src/lib/libm/common/complex/ctanl.c @@ -0,0 +1,48 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#pragma weak ctanl = __ctanl + +#include "libm.h" +#include "complex_wrapper.h" + +ldcomplex +ctanl(ldcomplex z) { + long double x, y; + ldcomplex ans, ct; + + x = LD_RE(z); + y = LD_IM(z); + LD_RE(z) = y; + LD_IM(z) = -x; + ct = ctanhl(z); + LD_RE(ans) = -LD_IM(ct); + LD_IM(ans) = LD_RE(ct); + return (ans); +} diff --git a/usr/src/lib/libm/common/complex/k_atan2.c b/usr/src/lib/libm/common/complex/k_atan2.c new file mode 100644 index 0000000000..f3fe1691c9 --- /dev/null +++ b/usr/src/lib/libm/common/complex/k_atan2.c @@ -0,0 +1,550 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2005 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#include "libm.h" /* __k_atan2 */ +#include "complex_wrapper.h" + +/* + * double __k_atan2(double y, double x, double *e) + * + * Compute atan2 with error terms. + * + * Important formula: + * 3 5 + * x x + * atan(x) = x - ----- + ----- - ... (for x <= 1) + * 3 5 + * + * pi 1 1 + * = --- - --- + --- - ... (for x > 1) + * 3 + * 2 x 3x + * + * Arg(x + y i) = sign(y) * atan2(|y|, x) + * = sign(y) * atan(|y|/x) (for x > 0) + * sign(y) * (PI - atan(|y|/|x|)) (for x < 0) + * Thus if x >> y (IEEE double: EXP(x) - EXP(y) >= 60): + * 1. (x > 0): atan2(y,x) ~ y/x + * 2. (x < 0): atan2(y,x) ~ sign(y) (PI - |y/x|)) + * Otherwise if x << y: + * atan2(y,x) ~ sign(y)*PI/2 - x/y + * + * __k_atan2 call static functions mx_poly, mx_atan + */ + +/* + * (void) mx_poly (double *z, double *a, double *e, int n) + * return + * e = a + z*(a + z*(a + ... z*(a + e)...)) + * 0 2 4 2n + * Note: + * 1. e and coefficient ai are represented by two double numbers. + * For e, the first one contain the leading 24 bits rounded, and the + * second one contain the remaining 53 bits (total 77 bits accuracy). + * For ai, the first one contian the leading 53 bits rounded, and the + * second is the remaining 53 bits (total 106 bits accuracy). + * 2. z is an array of three doubles. + * z[0] : the rounded value of Z (the intended value of z) + * z[1] : the leading 24 bits of Z rounded + * z[2] : the remaining 53 bits of Z + * Note that z[0] = z[1]+z[2] rounded. + * + */ + +static void +mx_poly(const double *z, const double *a, double *e, int n) { + double r, s, t, p_h, p_l, z_h, z_l, p; + int i; + + n = n + n; + p = e[0] + a[n]; + p_l = a[n + 1]; + p_h = (double) ((float) p); + p = a[n - 2] + z[0] * p; + z_h = z[1]; z_l = z[2]; + p_l += e[0] - (p_h - a[n]); + + for (i = n - 2; i >= 2; i -= 2) { + /* compute p = ai + z * p */ + t = z_h * p_h; + s = z[0] * p_l + p_h * z_l; + p_h = (double) ((float) p); + s += a[i + 1]; + r = t - (p_h - a[i]); + p = a[i - 2] + z[0] * p; + p_l = r + s; + } + e[0] = (double)((float) p); + t = z_h * p_h; + s = z[0] * p_l + p_h * z_l; + r = t - (e[0] - a[0]); + e[1] = r + s; +} + +/* + * Table of constants for atan from 0.125 to 8 + * 0.125 -- 0x3fc00000 --- (increment at bit 16) + * 0x3fc10000 + * 0x3fc20000 + * ... ... + * 0x401f0000 + * 8.000 -- 0x40200000 (total: 97) + * By K.C. Ng, March 9, 1989 + */ + +static const double TBL_atan_hi[] = { +1.243549945467614382e-01, 1.320397616146387620e-01, 1.397088742891636204e-01, +1.473614810886516302e-01, 1.549967419239409727e-01, 1.626138285979485676e-01, +1.702119252854744080e-01, 1.777902289926760471e-01, 1.853479499956947607e-01, +1.928843122579746439e-01, 2.003985538258785115e-01, 2.078899272022629863e-01, +2.153576996977380476e-01, 2.228011537593945213e-01, 2.302195872768437179e-01, +2.376123138654712419e-01, 2.449786631268641435e-01, 2.596296294082575118e-01, +2.741674511196587893e-01, 2.885873618940774099e-01, 3.028848683749714166e-01, +3.170557532091470287e-01, 3.310960767041321029e-01, 3.450021772071051318e-01, +3.587706702705721895e-01, 3.723984466767542023e-01, 3.858826693980737521e-01, +3.992207695752525431e-01, 4.124104415973872673e-01, 4.254496373700422662e-01, +4.383365598579578304e-01, 4.510696559885234436e-01, 4.636476090008060935e-01, +4.883339510564055352e-01, 5.123894603107377321e-01, 5.358112379604637043e-01, +5.585993153435624414e-01, 5.807563535676704136e-01, 6.022873461349641522e-01, +6.231993299340659043e-01, 6.435011087932843710e-01, 6.632029927060932861e-01, +6.823165548747480713e-01, 7.008544078844501923e-01, 7.188299996216245269e-01, +7.362574289814280970e-01, 7.531512809621944138e-01, 7.695264804056582975e-01, +7.853981633974482790e-01, 8.156919233162234217e-01, 8.441539861131710509e-01, +8.709034570756529758e-01, 8.960553845713439269e-01, 9.197196053504168578e-01, +9.420000403794636101e-01, 9.629943306809362058e-01, 9.827937232473290541e-01, +1.001483135694234639e+00, 1.019141344266349725e+00, 1.035841253008800145e+00, +1.051650212548373764e+00, 1.066630365315743623e+00, 1.080839000541168327e+00, +1.094328907321189925e+00, 1.107148717794090409e+00, 1.130953743979160375e+00, +1.152571997215667610e+00, 1.172273881128476303e+00, 1.190289949682531656e+00, +1.206817370285252489e+00, 1.222025323210989667e+00, 1.236059489478081863e+00, +1.249045772398254428e+00, 1.261093382252440387e+00, 1.272297395208717319e+00, +1.282740879744270757e+00, 1.292496667789785336e+00, 1.301628834009196156e+00, +1.310193935047555547e+00, 1.318242051016837113e+00, 1.325817663668032553e+00, +1.339705659598999565e+00, 1.352127380920954636e+00, 1.363300100359693845e+00, +1.373400766945015894e+00, 1.382574821490125894e+00, 1.390942827002418447e+00, +1.398605512271957618e+00, 1.405647649380269870e+00, 1.412141064608495311e+00, +1.418146998399631542e+00, 1.423717971406494032e+00, 1.428899272190732761e+00, +1.433730152484709031e+00, 1.438244794498222623e+00, 1.442473099109101931e+00, +1.446441332248135092e+00, +}; + +static const double TBL_atan_lo[] = { +-3.125324142453938311e-18, -1.276925400709959526e-17, 2.479758919089733066e-17, +5.409599147666297957e-18, 9.585415594114323829e-18, 7.784470643106252464e-18, +-3.541164079802125137e-18, 2.372599351477449041e-17, 4.180692268843078977e-18, +2.034098543938166622e-17, 3.139954287184449286e-18, 7.333160666520898500e-18, +4.738160130078732886e-19, -5.498822172446843173e-18, 1.231340452914270316e-17, +1.058231431371112987e-17, 1.069875561873445139e-17, 1.923875492461530410e-17, +8.261353575163771936e-18, -1.428369957377257085e-17, -1.101082790300136900e-17, +-1.893928924292642146e-17, -7.952610375793798701e-18, -2.293880475557830393e-17, +3.088733564861919217e-17, 1.961231150484565340e-17, 2.378822732491940868e-17, +2.246598105617042065e-17, 3.963462895355093301e-17, 2.331553074189288466e-17, +-2.494277030626540909e-17, 3.280735600183735558e-17, 2.269877745296168709e-17, +-1.137323618932958456e-17, -2.546278147285580353e-17, -4.063795683482557497e-18, +-5.455630548591626394e-18, -1.441464378193066908e-17, 2.950430737228402307e-17, +2.672403885140095079e-17, 1.583478505144428617e-17, -3.076054864429649001e-17, +6.943223671560007740e-18, -1.987626234335816123e-17, -2.147838844445698302e-17, +3.473937648299456719e-17, -2.425693465918206812e-17, -3.704991905602721293e-17, +3.061616997868383018e-17, -1.071456562778743077e-17, -4.841337011934916763e-17, +-2.269823590747287052e-17, 2.923876285774304890e-17, -4.057439412852767923e-17, +5.460837485846687627e-17, -3.986660595210752445e-18, 1.390331103123099845e-17, +9.438308023545392000e-17, 1.000401886936679889e-17, 3.194313981784503706e-17, +-9.650564731467513515e-17, -5.956589637160374564e-17, -1.567632251135907253e-17, +-5.490676155022364226e-18, 9.404471373566379412e-17, 7.123833804538446299e-17, +-9.159738508900378819e-17, 8.385188614028674371e-17, 7.683333629842068806e-17, +4.172467638861439118e-17, -2.979162864892849274e-17, 7.879752739459421280e-17, +-2.196203799612310905e-18, 3.242139621534960503e-17, 2.245875015034507026e-17, +-9.283188754266129476e-18, -6.830804768926660334e-17, -1.236918499824626670e-17, +8.745413734780278834e-17, -6.319394031144676258e-17, -8.824429373951136321e-17, +-2.599011860304134377e-17, 2.147674250751150961e-17, 1.093246171526936217e-16, +-3.307710355769516504e-17, -3.561490438648230100e-17, -9.843712133488842595e-17, +-2.324061182591627982e-17, -8.922630138234492386e-17, -9.573807110557223276e-17, +-8.263883782511013632e-17, 8.721870922223967507e-17, -6.457134743238754385e-17, +-4.396204466767636187e-17, -2.493019910264565554e-17, -1.105119435430315713e-16, +9.211323971545051565e-17, +}; + +/* + * mx_atan(x,err) + * Table look-up algorithm + * By K.C. Ng, March 9, 1989 + * + * Algorithm. + * + * The algorithm is based on atan(x)=atan(y)+atan((x-y)/(1+x*y)). + * We use poly1(x) to approximate atan(x) for x in [0,1/8] with + * error (relative) + * |(atan(x)-poly1(x))/x|<= 2^-83.41 + * + * and use poly2(x) to approximate atan(x) for x in [0,1/65] with + * error + * |atan(x)-poly2(x)|<= 2^-86.8 + * + * Here poly1 and poly2 are odd polynomial with the following form: + * x + x^3*(a1+x^2*(a2+...)) + * + * (0). Purge off Inf and NaN and 0 + * (1). Reduce x to positive by atan(x) = -atan(-x). + * (2). For x <= 1/8, use + * (2.1) if x < 2^(-prec/2), atan(x) = x with inexact flag raised + * (2.2) Otherwise + * atan(x) = poly1(x) + * (3). For x >= 8 then (prec = 78) + * (3.1) if x >= 2^prec, atan(x) = atan(inf) - pio2lo + * (3.2) if x >= 2^(prec/3), atan(x) = atan(inf) - 1/x + * (3.3) if x > 65, atan(x) = atan(inf) - poly2(1/x) + * (3.4) Otherwise, atan(x) = atan(inf) - poly1(1/x) + * + * (4). Now x is in (0.125, 8) + * Find y that match x to 4.5 bit after binary (easy). + * If iy is the high word of y, then + * single : j = (iy - 0x3e000000) >> 19 + * double : j = (iy - 0x3fc00000) >> 16 + * quad : j = (iy - 0x3ffc0000) >> 12 + * + * Let s = (x-y)/(1+x*y). Then + * atan(x) = atan(y) + poly1(s) + * = _TBL_atan_hi[j] + (_TBL_atan_lo[j] + poly2(s) ) + * + * Note. |s| <= 1.5384615385e-02 = 1/65. Maxium occurs at x = 1.03125 + * + */ + +#define P1 p[2] +#define P4 p[8] +#define P5 p[9] +#define P6 p[10] +#define P7 p[11] +#define P8 p[12] +#define P9 p[13] +static const double p[] = { + 1.0, + 0.0, + -3.33333333333333314830e-01, /* p1 = BFD55555 55555555 */ + -1.85030852238476921863e-17, /* p1_l = BC755525 9783A49C */ + 2.00000000000000011102e-01, /* p2 = 3FC99999 9999999A */ + -1.27263196576150347368e-17, /* p2_l = BC6D584B 0D874007 */ + -1.42857142857141405923e-01, /* p3 = BFC24924 9249245E */ + -1.34258204847170493327e-17, /* p3_l = BC6EF534 A112500D */ + 1.11111111110486909803e-01, /* p4 = 3FBC71C7 1C71176A */ + -9.09090907557387889470e-02, /* p5 = BFB745D1 73B47A7D */ + 7.69230541541713053189e-02, /* p6 = 3FB3B13A B1E68DE6 */ + -6.66645815401964159097e-02, /* p7 = BFB110EE 1584446A */ + 5.87081768778560317279e-02, /* p8 = 3FAE0EFF 87657733 */ + -4.90818147456113240690e-02, /* p9 = BFA92140 6A524B5C */ +}; +#define Q1 q[2] +#define Q3 q[6] +#define Q4 q[7] +#define Q5 q[8] +static const double q[] = { + 1.0, + 0.0, + -3.33333333333333314830e-01, /* q1 = BFD55555 55555555 */ + -1.85022941571278638733e-17, /* q1_l = BC7554E9 D20EFA66 */ + 1.99999999999999927836e-01, /* q2 = 3FC99999 99999997 */ + -1.28782564407438833398e-17, /* q2_l = BC6DB1FB 17217417 */ + -1.42857142855492280642e-01, /* q3 = BFC24924 92483C46 */ + 1.11111097130183356096e-01, /* q4 = 3FBC71C6 E06595CC */ + -9.08553303569109294013e-02, /* q5 = BFB7424B 808CDA76 */ +}; +static const double +one = 1.0, +pio2hi = 1.570796326794896558e+00, +pio2lo = 6.123233995736765886e-17; + +static double +mx_atan(double x, double *err) { + double y, z, r, s, t, w, s_h, s_l, x_h, x_l, zz[3], ee[2], z_h, + z_l, r_h, r_l, u, v; + int ix, iy, sign, j; + + ix = ((int *) &x)[HIWORD]; + sign = ix & 0x80000000; + ix ^= sign; + + /* for |x| < 1/8 */ + if (ix < 0x3fc00000) { + if (ix < 0x3f300000) { /* when |x| < 2**-12 */ + if (ix < 0x3d800000) { /* if |x| < 2**-39 */ + *err = (double) ((int) x); + return (x); + } + z = x * x; + t = x * z * (q[2] + z * (q[4] + z * q[6])); + r = x + t; + *err = t - (r - x); + return (r); + } + z = x * x; + + /* use double precision at p4 and on */ + ee[0] = z * + (P4 + z * + (P5 + z * (P6 + z * (P7 + z * (P8 + z * P9))))); + + x_h = (double) ((float) x); + z_h = (double) ((float) z); + x_l = x - x_h; + z_l = (x_h * x_h - z_h); + zz[0] = z; + zz[1] = z_h; + zz[2] = z_l + x_l * (x + x_h); + + /* + * compute (1+z*(p1+z*(p2+z*(p3+e)))) by call + * mx_poly + */ + + mx_poly(zz, p, ee, 3); + + /* finally x*(1+z*(p1+...)) */ + r = x_h * ee[0]; + t = x * ee[1] + x_l * ee[0]; + s = t + r; + *err = t - (s - r); + return (s); + } + /* for |x| >= 8.0 */ + if (ix >= 0x40200000) { /* x >= 8 */ + x = fabs(x); + if (ix >= 0x42600000) { /* x >= 2**39 */ + if (ix >= 0x44c00000) { /* x >= 2**77 */ + y = -pio2lo; + } else + y = one / x - pio2lo; + if (sign == 0) { + t = pio2hi - y; + *err = -(y - (pio2hi - t)); + } else { + t = y - pio2hi; + *err = y - (pio2hi + t); + } + return (t); + } else { + /* compute r = 1/x */ + r = one / x; + z = r * r; + if (ix < 0x40504000) { /* 8 < x < 65 */ + + /* use double precision at p4 and on */ + ee[0] = z * + (P4 + z * + (P5 + z * + (P6 + z * (P7 + z * (P8 + z * P9))))); + x_h = (double) ((float) x); + r_h = (double) ((float) r); + z_h = (double) ((float) z); + r_l = r * ((x_h - x) * r_h - (x_h * r_h - one)); + z_l = (r_h * r_h - z_h); + zz[0] = z; + zz[1] = z_h; + zz[2] = z_l + r_l * (r + r_h); + /* + * compute (1+z*(p1+z*(p2+z*(p3+e)))) by call + * mx_poly + */ + mx_poly(zz, p, ee, 3); + } else { /* x < 65 < 2**39 */ + /* use double precision at q3 and on */ + ee[0] = z * (Q3 + z * (Q4 + z * Q5)); + x_h = (double) ((float) x); + r_h = (double) ((float) r); + z_h = (double) ((float) z); + r_l = r * ((x_h - x) * r_h - (x_h * r_h - one)); + z_l = (r_h * r_h - z_h); + zz[0] = z; + zz[1] = z_h; + zz[2] = z_l + r_l * (r + r_h); + /* + * compute (1+z*(q1+z*(q2+e))) by call + * mx_poly + */ + mx_poly(zz, q, ee, 2); + } + /* pio2 - r*(1+...) */ + v = r_h * ee[0]; + t = pio2lo - (r * ee[1] + r_l * ee[0]); + if (sign == 0) { + s = pio2hi - v; + t -= (v - (pio2hi - s)); + } else { + s = v - pio2hi; + t = -(t - (v - (s + pio2hi))); + } + w = s + t; + *err = t - (w - s); + return (w); + } + } + /* now x is between 1/8 and 8 */ + ((int *) &x)[HIWORD] = ix; + iy = (ix + 0x00008000) & 0x7fff0000; + ((int *) &y)[HIWORD] = iy; + ((int *) &y)[LOWORD] = 0; + j = (iy - 0x3fc00000) >> 16; + + w = (x - y); + v = 1 / (one + x * y); + s = w * v; + z = s * s; + /* use double precision at q3 and on */ + ee[0] = z * (Q3 + z * (Q4 + z * Q5)); + s_h = (double) ((float) s); + z_h = (double) ((float) z); + x_h = (double) ((float) x); + t = (double) ((float) (one + x * y)); + r = -((x_h - x) * y - (x_h * y - (t - one))); + s_l = -v * (s_h * r - (w - s_h * t)); + z_l = (s_h * s_h - z_h); + zz[0] = z; + zz[1] = z_h; + zz[2] = z_l + s_l * (s + s_h); + /* compute (1+z*(q1+z*(q2+e))) by call mx_poly */ + mx_poly(zz, q, ee, 2); + v = s_h * ee[0]; + t = TBL_atan_lo[j] + (s * ee[1] + s_l * ee[0]); + u = TBL_atan_hi[j]; + s = u + v; + t += (v - (s - u)); + w = s + t; + *err = t - (w - s); + if (sign != 0) { + w = -w; + *err = -*err; + } + return (w); +} + +static const double + twom768 = 6.441148769597133308e-232, /* 2^-768 */ + two768 = 1.552518092300708935e+231, /* 2^768 */ + pi = 3.1415926535897931159979634685, + pi_lo = 1.224646799147353177e-16, + pio2 = 1.570796326794896558e+00, + pio2_lo = 6.123233995736765886e-17, + pio4 = 0.78539816339744827899949, + pio4_lo = 3.061616997868382943e-17, + pi3o4 = 2.356194490192344836998, + pi3o4_lo = 9.184850993605148829195e-17; + +double +__k_atan2(double y, double x, double *w) { + double t, xh, th, t1, t2, w1, w2; + int ix, iy, hx, hy, lx, ly; + + hy = ((int *) &y)[HIWORD]; + ly = ((int *) &y)[LOWORD]; + iy = hy & ~0x80000000; + + hx = ((int *) &x)[HIWORD]; + lx = ((int *) &x)[LOWORD]; + ix = hx & ~0x80000000; + + *w = 0.0; + if (ix >= 0x7ff00000 || iy >= 0x7ff00000) { /* ignore inexact */ + if (isnan(x) || isnan(y)) + return (x * y); + else if (iy < 0x7ff00000) { + if (hx >= 0) { /* ATAN2(+-finite, +inf) is +-0 */ + *w *= y; + return (*w); + } else { /* ATAN2(+-finite, -inf) is +-pi */ + *w = copysign(pi_lo, y); + return (copysign(pi, y)); + } + } else if (ix < 0x7ff00000) { + /* ATAN2(+-inf, finite) is +-pi/2 */ + *w = (hy >= 0)? pio2_lo : -pio2_lo; + return ((hy >= 0)? pio2 : -pio2); + } else if (hx > 0) { /* ATAN2(+-INF,+INF) = +-pi/4 */ + *w = (hy >= 0)? pio4_lo : -pio4_lo; + return ((hy >= 0)? pio4 : -pio4); + } else { /* ATAN2(+-INF,-INF) = +-3pi/4 */ + *w = (hy >= 0)? pi3o4_lo : -pi3o4_lo; + return ((hy >= 0)? pi3o4 : -pi3o4); + } + } else if ((ix | lx) == 0 || (iy | ly) == 0) { + if ((iy | ly) == 0) { + if (hx >= 0) /* ATAN2(+-0, +(0 <= x <= inf)) is +-0 */ + return (y); + else { /* ATAN2(+-0, -(0 <= x <= inf)) is +-pi */ + *w = (hy >= 0)? pi_lo : -pi_lo; + return ((hy >= 0)? pi : -pi); + } + } else { /* ATAN2(+-(anything but 0 and NaN), 0) is +-pi/2 */ + *w = (hy >= 0)? pio2_lo : -pio2_lo; + return ((hy >= 0)? pio2 : -pio2); + } + } else if (iy - ix > 0x06400000) { /* |x/y| < 2 ** -100 */ + *w = (hy >= 0)? pio2_lo : -pio2_lo; + return ((hy >= 0)? pio2 : -pio2); + } else if (ix - iy > 0x06400000) { /* |y/x| < 2 ** -100 */ + if (hx < 0) { + *w = (hy >= 0)? pi_lo : -pi_lo; + return ((hy >= 0)? pi : -pi); + } else { + t = y / x; + th = t; + ((int *) &th)[LOWORD] &= 0xf8000000; + xh = x; + ((int *) &xh)[LOWORD] &= 0xf8000000; + t1 = (x - xh) * t + xh * (t - th); + t2 = y - xh * th; + *w = (t2 - t1) / x; + return (t); + } + } else { + if (ix >= 0x5f300000) { + x *= twom768; + y *= twom768; + } else if (ix < 0x23d00000) { + x *= two768; + y *= two768; + } + y = fabs(y); + x = fabs(x); + t = y / x; + th = t; + ((int *) &th)[LOWORD] &= 0xf8000000; + xh = x; + ((int *) &xh)[LOWORD] &= 0xf8000000; + t1 = (x - xh) * t + xh * (t - th); + t2 = y - xh * th; + w1 = mx_atan(t, &w2); + w2 += (t2 - t1) / (x + y * t); + if (hx < 0) { + t1 = pi - w1; + t2 = pi - t1; + w2 = (pi_lo - w2) - (w1 - t2); + w1 = t1; + } + *w = (hy >= 0)? w2 : -w2; + return ((hy >= 0)? w1 : -w1); + } +} diff --git a/usr/src/lib/libm/common/complex/k_atan2l.c b/usr/src/lib/libm/common/complex/k_atan2l.c new file mode 100644 index 0000000000..5cd04f6995 --- /dev/null +++ b/usr/src/lib/libm/common/complex/k_atan2l.c @@ -0,0 +1,809 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2005 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#include "libm.h" /* __k_atan2l */ +#include "complex_wrapper.h" + +#if defined(__sparc) +#define HALF(x) ((int *) &x)[3] = 0; ((int *) &x)[2] &= 0xfe000000 +#elif defined(__x86) +#define HALF(x) ((int *) &x)[0] = 0 +#endif + +/* + * long double __k_atan2l(long double y, long double x, long double *e) + * + * Compute atan2l with error terms. + * + * Important formula: + * 3 5 + * x x + * atan(x) = x - ----- + ----- - ... (for x <= 1) + * 3 5 + * + * pi 1 1 + * = --- - --- + --- - ... (for x > 1) + * 3 + * 2 x 3x + * + * Arg(x + y i) = sign(y) * atan2(|y|, x) + * = sign(y) * atan(|y|/x) (for x > 0) + * sign(y) * (PI - atan(|y|/|x|)) (for x < 0) + * Thus if x >> y (IEEE double: EXP(x) - EXP(y) >= 60): + * 1. (x > 0): atan2(y,x) ~ y/x + * 2. (x < 0): atan2(y,x) ~ sign(y) (PI - |y/x|)) + * Otherwise if x << y: + * atan2(y,x) ~ sign(y)*PI/2 - x/y + * + * __k_atan2l call static functions mx_polyl, mx_atanl + */ + + +/* + * (void) mx_polyl (long double *z, long double *a, long double *e, int n) + * return + * e = a + z*(a + z*(a + ... z*(a + e)...)) + * 0 2 4 2n + * Note: + * 1. e and coefficient ai are represented by two long double numbers. + * For e, the first one contain the leading 53 bits (30 for x86 exteneded) + * and the second one contain the remaining 113 bits (64 for x86 extended). + * For ai, the first one contian the leading 53 bits (or 30 for x86) + * rounded, and the second is the remaining 113 bits (or 64 for x86). + * 2. z is an array of three doubles. + * z[0] : the rounded value of Z (the intended value of z) + * z[1] : the leading 32 (or 56) bits of Z rounded + * z[2] : the remaining 113 (or 64) bits of Z + * Note that z[0] = z[1]+z[2] rounded. + * + */ + +static void +mx_polyl(const long double *z, const long double *a, long double *e, int n) { + long double r, s, t, p_h, p_l, z_h, z_l, p, w; + int i; + n = n + n; + p = e[0] + a[n]; + p_l = a[n + 1]; + w = p; HALF(w); + p_h = w; + p = a[n - 2] + z[0] * p; + z_h = z[1]; z_l = z[2]; + p_l += e[0] - (p_h - a[n]); + + for (i = n - 2; i >= 2; i -= 2) { + + /* compute p = ai + z * p */ + t = z_h * p_h; + s = z[0] * p_l + p_h * z_l; + w = p; HALF(w); + p_h = w; + s += a[i + 1]; + r = t - (p_h - a[i]); + p = a[i - 2] + z[0] * p; + p_l = r + s; + } + w = p; HALF(w); + e[0] = w; + t = z_h * p_h; + s = z[0] * p_l + p_h * z_l; + r = t - (e[0] - a[0]); + e[1] = r + s; +} + +/* + * Table of constants for atan from 0.125 to 8 + * 0.125 -- 0x3ffc0000 --- (increment at bit 12) + * 0x3ffc1000 + * 0x3ffc2000 + * ... ... + * 0x4001f000 + * 8.000 -- 0x40020000 (total: 97) + */ + +static const long double TBL_atan_hil[] = { +#if defined(__sparc) +1.2435499454676143503135484916387102416568e-01L, +1.3203976161463874927468440652656953226250e-01L, +1.3970887428916364518336777673909505681607e-01L, +1.4736148108865163560980276039684551821066e-01L, +1.5499674192394098230371437493349219133371e-01L, +1.6261382859794857537364156376155780062019e-01L, +1.7021192528547440449049660709976171369543e-01L, +1.7779022899267607079662479921582468899456e-01L, +1.8534794999569476488602596122854464667261e-01L, +1.9288431225797466419705871069022730349878e-01L, +2.0039855382587851465394578503437838446153e-01L, +2.0788992720226299360533498310299432475629e-01L, +2.1535769969773804802445962716648964165745e-01L, +2.2280115375939451577103212214043255525024e-01L, +2.3021958727684373024017095967980299065551e-01L, +2.3761231386547125247388363432563777919892e-01L, +2.4497866312686415417208248121127580641959e-01L, +2.5962962940825753102994644318397190560106e-01L, +2.7416745111965879759937189834217578592444e-01L, +2.8858736189407739562361141995821834504332e-01L, +3.0288486837497140556055609450555821812277e-01L, +3.1705575320914700980901557667446732975852e-01L, +3.3109607670413209494433878775694455421259e-01L, +3.4500217720710510886768128690005168408290e-01L, +3.5877067027057222039592006392646052215363e-01L, +3.7239844667675422192365503828370182641413e-01L, +3.8588266939807377589769548460723139638186e-01L, +3.9922076957525256561471669615886476491104e-01L, +4.1241044159738730689979128966712694260920e-01L, +4.2544963737004228954226360518079233013817e-01L, +4.3833655985795780544561604921477130895882e-01L, +4.5106965598852347637563925728219344073798e-01L, +4.6364760900080611621425623146121439713344e-01L, +4.8833395105640552386716496074706484459644e-01L, +5.1238946031073770666660102058425923805558e-01L, +5.3581123796046370026908506870769144698471e-01L, +5.5859931534356243597150821640166122875873e-01L, +5.8075635356767039920327447500150082375122e-01L, +6.0228734613496418168212269420423291922459e-01L, +6.2319932993406593099247534906037459367793e-01L, +6.4350110879328438680280922871732260447265e-01L, +6.6320299270609325536325431023827583417226e-01L, +6.8231655487474807825642998171115298784729e-01L, +7.0085440788445017245795128178675127318623e-01L, +7.1882999962162450541701415152590469891043e-01L, +7.3625742898142813174283527108914662479274e-01L, +7.5315128096219438952473937026902888600575e-01L, +7.6952648040565826040682003598565401726598e-01L, +7.8539816339744830961566084581987569936977e-01L, +8.1569192331622341102146083874564582672284e-01L, +8.4415398611317100251784414827164746738632e-01L, +8.7090345707565295314017311259781407291650e-01L, +8.9605538457134395617480071802993779546602e-01L, +9.1971960535041681722860345482108940969311e-01L, +9.4200004037946366473793717053459362115891e-01L, +9.6299433068093620181519583599709989677298e-01L, +9.8279372324732906798571061101466603762572e-01L, +1.0014831356942347329183295953014374896343e+00L, +1.0191413442663497346383429170230636212354e+00L, +1.0358412530088001765846944703254440735476e+00L, +1.0516502125483736674598673120862999026920e+00L, +1.0666303653157435630791763474202799086015e+00L, +1.0808390005411683108871567292171997859003e+00L, +1.0943289073211899198927883146102352763033e+00L, +1.1071487177940905030170654601785370497543e+00L, +1.1309537439791604464709335155363277560026e+00L, +1.1525719972156675180401498626127514672834e+00L, +1.1722738811284763866005949441337046006865e+00L, +1.1902899496825317329277337748293182803384e+00L, +1.2068173702852525303955115800565576625682e+00L, +1.2220253232109896370417417439225704120294e+00L, +1.2360594894780819419094519711090786146210e+00L, +1.2490457723982544258299170772810900483550e+00L, +1.2610933822524404193139408812473357640124e+00L, +1.2722973952087173412961937498224805746463e+00L, +1.2827408797442707473628852511364955164072e+00L, +1.2924966677897852679030914214070816723528e+00L, +1.3016288340091961438047858503666855024453e+00L, +1.3101939350475556342564376891719053437537e+00L, +1.3182420510168370498593302023271363040427e+00L, +1.3258176636680324650592392104284756886164e+00L, +1.3397056595989995393283037525895557850243e+00L, +1.3521273809209546571891479413898127598774e+00L, +1.3633001003596939542892985278250991560269e+00L, +1.3734007669450158608612719264449610604836e+00L, +1.3825748214901258580599674177685685163955e+00L, +1.3909428270024183486427686943836432395486e+00L, +1.3986055122719575950126700816114282727858e+00L, +1.4056476493802697809521934019958080664406e+00L, +1.4121410646084952153676136718584890852820e+00L, +1.4181469983996314594038603039700988632607e+00L, +1.4237179714064941189018190466107297108905e+00L, +1.4288992721907326964184700745371984001389e+00L, +1.4337301524847089866404719096698873880264e+00L, +1.4382447944982225979614042479354816039669e+00L, +1.4424730991091018200252920599377291810352e+00L, +1.4464413322481351841999668424758803866109e+00L, +#elif defined(__x86) +1.243549945356789976358413696289e-01L, 1.320397615781985223293304443359e-01L, +1.397088742814958095550537109375e-01L, 1.473614810383878648281097412109e-01L, +1.549967419123277068138122558594e-01L, 1.626138285500928759574890136719e-01L, +1.702119252295233309268951416016e-01L, 1.777902289759367704391479492188e-01L, +1.853479499695822596549987792969e-01L, 1.928843122441321611404418945312e-01L, +2.003985538030974566936492919922e-01L, 2.078899272019043564796447753906e-01L, +2.153576996643096208572387695312e-01L, 2.228011537226848304271697998047e-01L, +2.302195872762240469455718994141e-01L, 2.376123138237744569778442382812e-01L, +2.449786631041206419467926025391e-01L, 2.596296293195337057113647460938e-01L, +2.741674510762095451354980468750e-01L, 2.885873618070036172866821289062e-01L, +3.028848683461546897888183593750e-01L, 3.170557531993836164474487304688e-01L, +3.310960766393691301345825195312e-01L, 3.450021771714091300964355468750e-01L, +3.587706702528521418571472167969e-01L, 3.723984466632828116416931152344e-01L, +3.858826693613082170486450195312e-01L, 3.992207695264369249343872070312e-01L, +4.124104415532201528549194335938e-01L, 4.254496373469009995460510253906e-01L, +4.383365598041564226150512695312e-01L, 4.510696559445932507514953613281e-01L, +4.636476089945062994956970214844e-01L, 4.883339509833604097366333007812e-01L, +5.123894601128995418548583984375e-01L, 5.358112377580255270004272460938e-01L, +5.585993151180446147918701171875e-01L, 5.807563534472137689590454101562e-01L, +6.022873460315167903900146484375e-01L, 6.231993297114968299865722656250e-01L, +6.435011087451130151748657226562e-01L, 6.632029926404356956481933593750e-01L, +6.823165547102689743041992187500e-01L, 7.008544078562408685684204101562e-01L, +7.188299994450062513351440429688e-01L, 7.362574287690222263336181640625e-01L, +7.531512808054685592651367187500e-01L, 7.695264802314341068267822265625e-01L, +7.853981633670628070831298828125e-01L, 8.156919232569634914398193359375e-01L, +8.441539860796183347702026367188e-01L, 8.709034570492804050445556640625e-01L, +8.960553845390677452087402343750e-01L, 9.197196052409708499908447265625e-01L, +9.420000403188169002532958984375e-01L, 9.629943305626511573791503906250e-01L, +9.827937232330441474914550781250e-01L, 1.001483135391026735305786132812e+00L, +1.019141343887895345687866210938e+00L, 1.035841252654790878295898437500e+00L, +1.051650212146341800689697265625e+00L, 1.066630364861339330673217773438e+00L, +1.080839000176638364791870117188e+00L, 1.094328907318413257598876953125e+00L, +1.107148717623203992843627929688e+00L, 1.130953743588179349899291992188e+00L, +1.152571997139602899551391601562e+00L, 1.172273880802094936370849609375e+00L, +1.190289949532598257064819335938e+00L, 1.206817369908094406127929687500e+00L, +1.222025323193520307540893554688e+00L, 1.236059489194303750991821289062e+00L, +1.249045772012323141098022460938e+00L, 1.261093381792306900024414062500e+00L, +1.272297394927591085433959960938e+00L, 1.282740879338234663009643554688e+00L, +1.292496667709201574325561523438e+00L, 1.301628833636641502380371093750e+00L, +1.310193934943526983261108398438e+00L, 1.318242050707340240478515625000e+00L, +1.325817663222551345825195312500e+00L, 1.339705659542232751846313476562e+00L, +1.352127380669116973876953125000e+00L, 1.363300099968910217285156250000e+00L, +1.373400766868144273757934570312e+00L, 1.382574821356683969497680664062e+00L, +1.390942826867103576660156250000e+00L, 1.398605511989444494247436523438e+00L, +1.405647648964077234268188476562e+00L, 1.412141064181923866271972656250e+00L, +1.418146998155862092971801757812e+00L, 1.423717970959842205047607421875e+00L, +1.428899271879345178604125976562e+00L, 1.433730152435600757598876953125e+00L, +1.438244794495403766632080078125e+00L, 1.442473099101334810256958007812e+00L, +1.446441331878304481506347656250e+00L, +#endif +}; +static const long double TBL_atan_lol[] = { +#if defined(__sparc) +1.4074869197628063802317202820414310039556e-36L, +-4.9596961594739925555730439437999675295505e-36L, +8.9527745625194648873931213446361849472788e-36L, +1.1880437423207895718180765843544965589427e-35L, +-2.7810278112045145378425375128234365381448e-37L, +1.4797220377023800327295536234315147262387e-36L, +-4.2169561400548198732870384801849639863829e-36L, +7.2431229666913484649930323656316023494680e-36L, +-2.1573430089839170299895679353790663182462e-36L, +-9.9515745405126723554452367298128605186305e-36L, +-3.9065558992324838181617569730397882363067e-36L, +5.5260292271793726813211980664661124518807e-36L, +8.8415722215914321807682254318036452043689e-36L, +-8.1767728791586179254193323628285599800711e-36L, +-1.3344123034656142243797113823028330070762e-36L, +-4.4927331207813382908930733924681325892188e-36L, +4.4945511471812490393201824336762495687730e-36L, +-1.6688081504279223555776724459648440567274e-35L, +1.5629757586107955769461086568937329684113e-35L, +-2.2389835563308078552507970385331510848109e-35L, +-4.8312321745547311551870450671182151367050e-36L, +-1.4336172352905832876958926610980698844309e-35L, +-8.7440181998899932802989174170960593316080e-36L, +5.9284636008529837445780360785464550143016e-36L, +-2.2376651248436241276061055295043514993630e-35L, +6.0745837599336105414280310756677442136480e-36L, +1.5372187110451949677792344762029967023093e-35L, +2.0976068056751156241657121582478790247159e-35L, +-5.5623956405495438060726862202622807523700e-36L, +1.9697366707832471841858411934897351901523e-35L, +2.1070311964479488509034733639424887543697e-35L, +-2.3027356362982001602256518510854229844561e-35L, +4.8950964225733349266861843522029764772843e-36L, +-7.2380143477794458213872723050820253166391e-36L, +1.6365648865703614031637443396049568858105e-35L, +-3.9885811958234530793729129919803234197399e-35L, +4.1587722120912613510417783923227421336929e-35L, +3.8347421454556472153684687377337135027394e-35L, +-9.2251178933638721723515896465489002497864e-36L, +1.4094619690455989526175736741854656192178e-36L, +3.3568857805472235270612851425810803679451e-35L, +3.9090991055522552395018106803232118803401e-35L, +5.2956416979654208140521862707297033857956e-36L, +-5.0960846819945514367847063923662507136721e-36L, +-4.4959014425277615858329680393918315204998e-35L, +3.8039226544551634266566857615962609653834e-35L, +-4.4056522872895512108308642196611689657618e-36L, +1.6025024192482161076223807753425619076948e-36L, +2.1679525325309452561992610065108380635264e-35L, +1.9844038013515422125715362925736754104066e-35L, +3.9139619471799746834505227353568432457241e-35L, +2.1113443807975453505518453436799561854730e-35L, +3.1558557277444692755039816944392770185432e-35L, +1.6295044520355461408265585619500238335614e-35L, +-3.5087245209270305856151230356171213582305e-35L, +2.9041041864282855679591055270946117300088e-35L, +-2.3128843453818356590931995209806627233282e-35L, +-7.7124923181471578439967973820714857839953e-35L, +2.7539027829886922429092063590445808781462e-35L, +-9.4500899453181308951084545990839335972452e-35L, +-7.3061755302032092337594946001641651543473e-35L, +-4.1736144813953752193952770157406952602798e-35L, +3.4369948356256407045344855262863733571105e-35L, +-6.3790243492298090907302084924276831116460e-35L, +-9.6842943816353261291004127866079538980649e-36L, +4.8746757539138870909275958326700072821615e-35L, +-8.7533886477084190884511601368582548254655e-35L, +1.4284743992327918892692551138086727754845e-35L, +5.7262776211073389542565625693479173445042e-35L, +-3.2254883148780411245594822270747948565684e-35L, +7.8853548190609877325965525252380833808405e-35L, +8.4081736739037194097515038365370730251333e-35L, +7.4722870357563683815078242981933587273670e-35L, +7.9977202825793435289434813600890494256112e-36L, +-8.0577840773362139054848492346292673645405e-35L, +1.4217746753670583065490040209048757624336e-35L, +1.2232486914221205004109743560319090913328e-35L, +8.9696055070830036447361957217943988339065e-35L, +-3.1480394435081884410686066739846269858951e-35L, +-5.0927146040715345013240642517608928352977e-35L, +-5.7431997715924136568133859432702789493569e-35L, +-4.3920451405083770279099766080476485439987e-35L, +9.1106753984907715563018666776308759323326e-35L, +-3.7032569014272841009512400773061537538358e-35L, +8.8167419429746714276909825405131416764489e-35L, +-3.8389341696028352503752312861740895209678e-36L, +-3.3462959341960891546340895508017603408404e-35L, +-3.9212626776786074383916188498955828634947e-35L, +-7.8340397396377867255864494568594088378648e-35L, +7.4681018632456986520600640340627309824469e-35L, +8.9110918618956918451135594876165314884113e-35L, +3.9418160632271890530431797145664308529115e-35L, +-4.1048114088580104820193435638327617443913e-35L, +-2.3165419451582153326383944756220900454330e-35L, +-1.8428312581525319409399330203703211113843e-35L, +7.1477316546709482345411712017906842769961e-35L, +2.9914501578435874662153637707016094237004e-35L, +#elif defined(__x86) +1.108243739551347953496477557317e-11L, 3.644022694535396219063202730280e-11L, +7.667835628314065801595065768845e-12L, 5.026377078169301918590803009109e-11L, +1.161327548990211907411719105561e-11L, 4.785569941615255008968280209991e-11L, +5.595107356360146549819920947848e-11L, 1.673930035747684999707469623769e-11L, +2.611250523102718193166964451527e-11L, 1.384250305661681615897729354721e-11L, +2.278105796029649304219088055497e-11L, 3.586371256902077123693302823191e-13L, +3.342842716722085763523965049902e-11L, 3.670968534386232233574504707347e-11L, +6.196832945990602657404893210974e-13L, 4.169679549603939604438777470618e-11L, +2.274351222528987867221331091414e-11L, 8.872382531858169709022188891298e-11L, +4.344925246387385146717580155420e-11L, 8.707377833692929105196832265348e-11L, +2.881671577173773513055821329154e-11L, 9.763393361566846205717315422347e-12L, +6.476296480975626822569454546857e-11L, 3.569597877124574002505169001136e-11L, +1.772007853877284712958549977698e-11L, 1.347141028196192304932683248872e-11L, +3.676555884905046507598141175404e-11L, 4.881564068032948912761478588710e-11L, +4.416715404487185607337693704681e-11L, 2.314128999621257979016734983553e-11L, +5.380138283056477968352133002913e-11L, 4.393022562414389595406841771063e-11L, +6.299816718559209976839402028537e-12L, 7.304511413053165996581483735843e-11L, +1.978381648117426221467592544212e-10L, 2.024381732686578226139414070989e-10L, +2.255178211796380992141612703464e-10L, 1.204566302442290648452508620986e-10L, +1.034473912921080457667329099995e-10L, 2.225691010059030834353745950874e-10L, +4.817137162794350606107263804151e-11L, 6.565755971506095086327587326326e-11L, +1.644791039522307629611529931429e-10L, 2.820930388953087163050126809014e-11L, +1.766182540818701085571546539514e-10L, 2.124059054092171070266466628320e-10L, +1.567258302596026515190288816001e-10L, 1.742241535800378094231540188685e-10L, +3.038550253253096300737572104929e-11L, 5.925991958164150280814584656688e-11L, +3.355266774764151155289750652594e-11L, 2.637254809561744853531409402995e-11L, +3.227621096606048365493782702458e-11L, 1.094459672377587282585894259882e-10L, +6.064676448464127209709358607166e-11L, 1.182850444360454453720999258140e-10L, +1.428492049425553288966601449688e-11L, 3.032079976125434624889374125094e-10L, +3.784543889504767060855636487744e-10L, 3.540092982887960328254439790467e-10L, +4.020318667701700464612998296302e-10L, 4.544042324059585739827798668654e-10L, +3.645299460952866120296998202703e-10L, 2.776662293911361485235212513020e-12L, +1.708865101734375304910370400700e-10L, 3.909810965716415233488278047493e-10L, +7.606461848875826105025137974947e-11L, 3.263814502297453347587046149712e-10L, +1.499334758629144388918183376012e-10L, 3.771581242675818925565576303133e-10L, +1.746932950084818923507049088298e-11L, 2.837781909176306820465786987027e-10L, +3.859312847318946163435901230778e-10L, 4.601335192895268187473357720101e-10L, +2.811262558622337888849804940684e-10L, 4.060360843532416964489955306249e-10L, +8.058369357752989796958168458531e-11L, 3.725546414244147566166855921414e-10L, +1.040286509953292907344053122733e-10L, 3.094968093808145773271362531155e-10L, +4.454811192340438979284756311844e-10L, 5.676678748199027602705574110388e-11L, +2.518376833121948163898128509842e-10L, 3.907837370041422778250991189943e-10L, +7.687158710333735613246114865100e-11L, 1.334418885622867537060685125566e-10L, +1.353147719826124443836432060856e-10L, 2.825131007652335581739282335732e-10L, +4.161925466840049254333079881002e-10L, 4.265713490956410156084891599630e-10L, +2.437693664320585461575989523716e-10L, 4.466519138542116247357297503086e-10L, +3.113875178143440979746983590908e-10L, 4.910822904159495654488736486097e-11L, +2.818831329324169810481585538618e-12L, 7.767009768334052125229252512543e-12L, +3.698307026936191862258804165254e-10L, +#endif +}; + +/* + * mx_atanl(x, err) + * Table look-up algorithm + * By K.C. Ng, March 9, 1989 + * + * Algorithm. + * + * The algorithm is based on atan(x)=atan(y)+atan((x-y)/(1+x*y)). + * We use poly1(x) to approximate atan(x) for x in [0,1/8] with + * error (relative) + * |(atan(x)-poly1(x))/x|<= 2^-140 + * + * and use poly2(x) to approximate atan(x) for x in [0,1/65] with + * error + * |atan(x)-poly2(x)|<= 2^-143.7 + * + * Here poly1 and poly2 are odd polynomial with the following form: + * x + x^3*(a1+x^2*(a2+...)) + * + * (0). Purge off Inf and NaN and 0 + * (1). Reduce x to positive by atan(x) = -atan(-x). + * (2). For x <= 1/8, use + * (2.1) if x < 2^(-prec/2), atan(x) = x with inexact flag raised + * (2.2) Otherwise + * atan(x) = poly1(x) + * (3). For x >= 8 then (prec = 78) + * (3.1) if x >= 2^prec, atan(x) = atan(inf) - pio2_lo + * (3.2) if x >= 2^(prec/3), atan(x) = atan(inf) - 1/x + * (3.3) if x > 65, atan(x) = atan(inf) - poly2(1/x) + * (3.4) Otherwise, atan(x) = atan(inf) - poly1(1/x) + * + * (4). Now x is in (0.125, 8) + * Find y that match x to 4.5 bit after binary (easy). + * If iy is the high word of y, then + * single : j = (iy - 0x3e000000) >> 19 + * double : j = (iy - 0x3fc00000) >> 16 + * quad : j = (iy - 0x3ffc0000) >> 12 + * + * Let s = (x-y)/(1+x*y). Then + * atan(x) = atan(y) + poly1(s) + * = _TBL_atan_hi[j] + (_TBL_atan_lo[j] + poly2(s) ) + * + * Note. |s| <= 1.5384615385e-02 = 1/65. Maxium occurs at x = 1.03125 + * + */ + +/* + * p[0] - p[16] for atan(x) = + * x + x^3*(p1+x^2*(p2+...)) + */ +static const long double pe[] = { + 1.0L, + 0.0L, +#if defined(__sparc) + -0.33333333333333332870740406406184774823L, + -4.62592926927148558508441072595508240609e-18L, + 0.19999999999999999722444243843710864894L, + 2.77555756156289124602047010782090464486e-18L, + -0.14285714285714285615158658515611023176L, + -9.91270557700756738621231719241800559409e-19L, +#elif defined(__x86) + -0.33333333325572311878204345703125L, + -7.76102145512898763020833333192787755766644373e-11L, + 0.19999999995343387126922607421875L, + 4.65661287307739257812498949613909375938538636e-11L, + -0.142857142840512096881866455078125L, + -1.66307602609906877787419703858463013035681375e-11L, +#endif +}; + +static const long double p[] = { /* p[0] - p[16] */ + 1.0L, + -3.33333333333333333333333333333333333319278775586e-0001L, + 1.99999999999999999999999999999999894961390937601e-0001L, + -1.42857142857142857142857142856866970385846301312e-0001L, + 1.11111111111111111111111110742899094415954427738e-0001L, + -9.09090909090909090909087972707015549231951421806e-0002L, + 7.69230769230769230767699003016385628597359717046e-0002L, + -6.66666666666666666113842763495291228025226575259e-0002L, + 5.88235294117646915706902204947653640091126695962e-0002L, + -5.26315789473657016886225044679594035524579379810e-0002L, + 4.76190476186633969331771169790375592681525481267e-0002L, + -4.34782608290146274616081389793141896576997370161e-0002L, + 3.99999968161267722260103962788865225205057218988e-0002L, + -3.70368536844778256320786172745225703228683638328e-0002L, + 3.44752320396524479494062858284036892703898522150e-0002L, + -3.20491216046653214683721787776813360591233428081e-0002L, + 2.67632651033434456758550618122802167256870856514e-0002L, +}; + +/* q[0] - q[9] */ +static const long double qe[] = { + 1.0L, + 0.0L, +#if defined(__sparc) + -0.33333333333333332870740406406184774823486804962158203125L, + -4.625929269271485585069345465471207312531868714634217630e-18L, + 0.19999999999999999722444243843710864894092082977294921875L, + 2.7755575615628864268260553912956813621977220359134667560e-18L, +#elif defined(__x86) + -0.33333333325572311878204345703125L, + -7.76102145512898763020833333042135150927893e-11L, + 0.19999999995343387126922607421875L, + 4.656612873077392578124507576697622106863058e-11L, +#endif +}; + +static const long double q[] = { /* q[0] - q[9] */ + -3.33333333333333333333333333333333333304213515094e-0001L, + 1.99999999999999999999999999999995075766976221077e-0001L, + -1.42857142857142857142857142570379604317921113079e-0001L, + 1.11111111111111111111102923861900979127978214077e-0001L, + -9.09090909090909089586854075816999506863320031460e-0002L, + 7.69230769230756334929213246003824644696974730368e-0002L, + -6.66666666589192433974402013508912138168133579856e-0002L, + 5.88235013696778007696800252045588307023299350858e-0002L, + -5.25754959898164576495303840687699583228444695685e-0002L, +}; + +static const long double +two8700 = 9.140338438955067659002088492701e+2618L, /* 2^8700 */ +twom8700 = 1.094051392821643668051436593760e-2619L, /* 2^-8700 */ +one = 1.0L, +zero = 0.0L, +pi = 3.1415926535897932384626433832795028841971693993751L, +pio2 = 1.57079632679489661923132169163975144209858469968755L, +pio4 = 0.785398163397448309615660845819875721049292349843776L, +pi3o4 = 2.356194490192344928846982537459627163147877049531329L, +#if defined(__sparc) +pi_lo = 8.67181013012378102479704402604335196876232e-35L, +pio2_lo = 4.33590506506189051239852201302167598438116e-35L, +pio4_lo = 2.16795253253094525619926100651083799219058e-35L, +pi3o4_lo = 6.50385759759283576859778301953251397657174e-35L; +#elif defined(__x86) +pi_lo = -5.01655761266833202355732708e-20L, +pio2_lo = -2.50827880633416601177866354e-20L, +pio4_lo = -1.25413940316708300588933177e-20L, +pi3o4_lo = -9.18342907192877118770525931e-20L; +#endif + +static long double +mx_atanl(long double x, long double *err) { + long double y, z, r, s, t, w, s_h, s_l, x_h, x_l, zz[3], ee[2], z_h, + z_l, r_h, r_l, u, v; + int ix, iy, hx, i, j; + float fx; + + hx = HI_XWORD(x); + ix = hx & (~0x80000000); + + /* for |x| < 1/8 */ + if (ix < 0x3ffc0000) { + if (ix < 0x3ff30000) { /* when |x| < 2**-12 */ + if (ix < 0x3fc60000) { /* if |x| < 2**-prec/2 */ + *err = (long double) ((int) x); + return (x); + } + z = x * x; + t = q[8]; + for (i = 7; i >= 0; i--) t = q[i] + z * t; + t *= x * z; + r = x + t; + *err = t - (r - x); + return (r); + } + z = x * x; + + /* use long double precision at p4 and on */ + t = p[16]; + for (i = 15; i >= 4; i--) t = p[i] + z * t; + ee[0] = z * t; + + x_h = x; HALF(x_h); + z_h = z; HALF(z_h); + x_l = x - x_h; + z_l = (x_h * x_h - z_h); + zz[0] = z; + zz[1] = z_h; + zz[2] = z_l + x_l * (x + x_h); + + /* compute (1+z*(p1+z*(p2+z*(p3+e)))) */ + + mx_polyl(zz, pe, ee, 3); + + /* finally x*(1+z*(p1+...)) */ + r = x_h * ee[0]; + t = x * ee[1] + x_l * ee[0]; + s = t + r; + *err = t - (s - r); + return (s); + } + /* for |x| >= 8.0 */ + if (ix >= 0x40020000) { /* x >= 8 */ + x = fabsl(x); + if (ix >= 0x402e0000) { /* x >= 2**47 */ + if (ix >= 0x408b0000) { /* x >= 2**140 */ + y = -pio2_lo; + } else + y = one / x - pio2_lo; + if (hx >= 0) { + t = pio2 - y; + *err = -(y - (pio2 - t)); + } else { + t = y - pio2; + *err = y - (pio2 + t); + } + return (t); + } else { + /* compute r = 1/x */ + r = one / x; + z = r * r; + x_h = x; HALF(x_h); + r_h = r; HALF(r_h); + z_h = z; HALF(z_h); + r_l = r * ((x_h - x) * r_h - (x_h * r_h - one)); + z_l = (r_h * r_h - z_h); + zz[0] = z; + zz[1] = z_h; + zz[2] = z_l + r_l * (r + r_h); + if (ix < 0x40050400) { /* 8 < x < 65 */ + /* use double precision at p4 and on */ + t = p[16]; + for (i = 15; i >= 4; i--) t = p[i] + z * t; + ee[0] = z * t; + /* compute (1+z*(p1+z*(p2+z*(p3+e)))) */ + mx_polyl(zz, pe, ee, 3); + } else { /* x < 65 < 2**47 */ + /* use long double at q3 and on */ + t = q[8]; + for (i = 7; i >= 2; i--) t = q[i] + z * t; + ee[0] = z * t; + /* compute (1+z*(q1+z*(q2+e))) */ + mx_polyl(zz, qe, ee, 2); + } + /* pio2 - r*(1+...) */ + v = r_h * ee[0]; + t = pio2_lo - (r * ee[1] + r_l * ee[0]); + if (hx >= 0) { + s = pio2 - v; + t -= (v - (pio2 - s)); + } else { + s = v - pio2; + t = -(t - (v - (s + pio2))); + } + w = s + t; + *err = t - (w - s); + return (w); + } + } + /* now x is between 1/8 and 8 */ + iy = (ix + 0x00000800) & 0x7ffff000; + j = (iy - 0x3ffc0000) >> 12; + ((int *) &fx)[0] = 0x3e000000 + (j << 19); + y = (long double) fx; + x = fabsl(x); + + w = (x - y); + v = 1.0L / (one + x * y); + s = w * v; + z = s * s; + /* use long double precision at q3 and on */ + t = q[8]; + for (i = 7; i >= 2; i--) t = q[i] + z * t; + ee[0] = z * t; + s_h = s; HALF(s_h); + z_h = z; HALF(z_h); + x_h = x; HALF(x_h); + t = one + x * y; HALF(t); + r = -((x_h - x) * y - (x_h * y - (t - one))); + s_l = -v * (s_h * r - (w - s_h * t)); + z_l = (s_h * s_h - z_h); + zz[0] = z; + zz[1] = z_h; + zz[2] = z_l + s_l * (s + s_h); + /* compute (1+z*(q1+z*(q2+e))) by call mx_poly */ + mx_polyl(zz, qe, ee, 2); + v = s_h * ee[0]; + t = TBL_atan_lol[j] + (s * ee[1] + s_l * ee[0]); + u = TBL_atan_hil[j]; + s = u + v; + t += (v - (s - u)); + w = s + t; + *err = t - (w - s); + if (hx < 0) { + w = -w; + *err = -*err; + } + return (w); +} + +long double +__k_atan2l(long double y, long double x, long double *w) { + long double t, xh, th, t1, t2, w1, w2; + int ix, iy, hx, hy; + + hy = HI_XWORD(y); + hx = HI_XWORD(x); + iy = hy & ~0x80000000; + ix = hx & ~0x80000000; + + *w = 0.0; + if (ix >= 0x7fff0000 || iy >= 0x7fff0000) { /* ignore inexact */ + if (isnanl(x) || isnanl(y)) + return (x * y); + else if (iy < 0x7fff0000) { + if (hx >= 0) { /* ATAN2(+-finite, +inf) is +-0 */ + *w *= y; + return (*w); + } else { /* ATAN2(+-finite, -inf) is +-pi */ + *w = copysignl(pi_lo, y); + return (copysignl(pi, y)); + } + } else if (ix < 0x7fff0000) { + /* ATAN2(+-inf, finite) is +-pi/2 */ + *w = (hy >= 0)? pio2_lo : -pio2_lo; + return ((hy >= 0)? pio2 : -pio2); + } else if (hx > 0) { /* ATAN2(+-INF,+INF) = +-pi/4 */ + *w = (hy >= 0)? pio4_lo : -pio4_lo; + return ((hy >= 0)? pio4 : -pio4); + } else { /* ATAN2(+-INF,-INF) = +-3pi/4 */ + *w = (hy >= 0)? pi3o4_lo : -pi3o4_lo; + return ((hy >= 0)? pi3o4 : -pi3o4); + } + } else if (x == zero || y == zero) { + if (y == zero) { + if (hx >= 0) /* ATAN2(+-0, +(0 <= x <= inf)) is +-0 */ + return (y); + else { /* ATAN2(+-0, -(0 <= x <= inf)) is +-pi */ + *w = (hy >= 0)? pi_lo : -pi_lo; + return ((hy >= 0)? pi : -pi); + } + } else { /* ATAN2(+-(anything but 0 and NaN), 0) is +-pi/2 */ + *w = (hy >= 0)? pio2_lo : -pio2_lo; + return ((hy >= 0)? pio2 : -pio2); + } + } else if (iy - ix > 0x00640000) { /* |x/y| < 2 ** -100 */ + *w = (hy >= 0)? pio2_lo : -pio2_lo; + return ((hy >= 0)? pio2 : -pio2); + } else if (ix - iy > 0x00640000) { /* |y/x| < 2 ** -100 */ + if (hx < 0) { + *w = (hy >= 0)? pi_lo : -pi_lo; + return ((hy >= 0)? pi : -pi); + } else { + t = y / x; + th = t; HALF(th); + xh = x; HALF(xh); + t1 = (x - xh) * t + xh * (t - th); + t2 = y - xh * th; + *w = (t2 - t1) / x; + return (t); + } + } else { + if (ix >= 0x5fff3000) { + x *= twom8700; + y *= twom8700; + } else if (ix < 0x203d0000) { + x *= two8700; + y *= two8700; + } + y = fabsl(y); + x = fabsl(x); + t = y / x; + th = t; HALF(th); + xh = x; HALF(xh); + t1 = (x - xh) * t + xh * (t - th); + t2 = y - xh * th; + w1 = mx_atanl(t, &w2); + w2 += (t2 - t1) / (x + y * t); + if (hx < 0) { + t1 = pi - w1; + t2 = pi - t1; + w2 = (pi_lo - w2) - (w1 - t2); + w1 = t1; + } + *w = (hy >= 0)? w2 : -w2; + return ((hy >= 0)? w1 : -w1); + } +} diff --git a/usr/src/lib/libm/common/complex/k_cexp.c b/usr/src/lib/libm/common/complex/k_cexp.c new file mode 100644 index 0000000000..0befa68fc1 --- /dev/null +++ b/usr/src/lib/libm/common/complex/k_cexp.c @@ -0,0 +1,180 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +/* INDENT OFF */ +/* + * double __k_cexp(double x, int *n); + * Returns the exponential of x in the form of 2**n * y, y=__k_cexp(x,&n). + * + * Method + * 1. Argument reduction: + * Reduce x to an r so that |r| <= 0.5*ln2 ~ 0.34658. + * Given x, find r and integer k such that + * + * x = k*ln2 + r, |r| <= 0.5*ln2. + * + * Here r will be represented as r = hi-lo for better + * accuracy. + * + * 2. Approximation of exp(r) by a special rational function on + * the interval [0,0.34658]: + * Write + * R(r**2) = r*(exp(r)+1)/(exp(r)-1) = 2 + r*r/6 - r**4/360 + ... + * We use a special Remez algorithm on [0,0.34658] to generate + * a polynomial of degree 5 to approximate R. The maximum error + * of this polynomial approximation is bounded by 2**-59. In + * other words, + * R(z) ~ 2.0 + P1*z + P2*z**2 + P3*z**3 + P4*z**4 + P5*z**5 + * (where z=r*r, and the values of P1 to P5 are listed below) + * and + * | 5 | -59 + * | 2.0+P1*z+...+P5*z - R(z) | <= 2 + * | | + * The computation of exp(r) thus becomes + * 2*r + * exp(r) = 1 + ------- + * R - r + * r*R1(r) + * = 1 + r + ----------- (for better accuracy) + * 2 - R1(r) + * where + * 2 4 10 + * R1(r) = r - (P1*r + P2*r + ... + P5*r ). + * + * 3. Return n = k and __k_cexp = exp(r). + * + * Special cases: + * exp(INF) is INF, exp(NaN) is NaN; + * exp(-INF) is 0, and + * for finite argument, only exp(0)=1 is exact. + * + * Range and Accuracy: + * When |x| is really big, say |x| > 50000, the accuracy + * is not important because the ultimate result will over or under + * flow. So we will simply replace n = 50000 and r = 0.0. For + * moderate size x, according to an error analysis, the error is + * always less than 1 ulp (unit in the last place). + * + * Constants: + * The hexadecimal values are the intended ones for the following + * constants. The decimal values may be used, provided that the + * compiler will convert from decimal to binary accurately enough + * to produce the hexadecimal values shown. + */ +/* INDENT ON */ + +#include "libm.h" /* __k_cexp */ +#include "complex_wrapper.h" /* HI_WORD/LO_WORD */ + +/* INDENT OFF */ +static const double +one = 1.0, +two128 = 3.40282366920938463463e+38, +halF[2] = { + 0.5, -0.5, +}, +ln2HI[2] = { + 6.93147180369123816490e-01, /* 0x3fe62e42, 0xfee00000 */ + -6.93147180369123816490e-01, /* 0xbfe62e42, 0xfee00000 */ +}, +ln2LO[2] = { + 1.90821492927058770002e-10, /* 0x3dea39ef, 0x35793c76 */ + -1.90821492927058770002e-10, /* 0xbdea39ef, 0x35793c76 */ +}, +invln2 = 1.44269504088896338700e+00, /* 0x3ff71547, 0x652b82fe */ +P1 = 1.66666666666666019037e-01, /* 0x3FC55555, 0x5555553E */ +P2 = -2.77777777770155933842e-03, /* 0xBF66C16C, 0x16BEBD93 */ +P3 = 6.61375632143793436117e-05, /* 0x3F11566A, 0xAF25DE2C */ +P4 = -1.65339022054652515390e-06, /* 0xBEBBBD41, 0xC5D26BF1 */ +P5 = 4.13813679705723846039e-08; /* 0x3E663769, 0x72BEA4D0 */ +/* INDENT ON */ + +double +__k_cexp(double x, int *n) { + double hi = 0.0L, lo = 0.0L, c, t; + int k, xsb; + unsigned hx, lx; + + hx = HI_WORD(x); /* high word of x */ + lx = LO_WORD(x); /* low word of x */ + xsb = (hx >> 31) & 1; /* sign bit of x */ + hx &= 0x7fffffff; /* high word of |x| */ + + /* filter out non-finite argument */ + if (hx >= 0x40e86a00) { /* if |x| > 50000 */ + if (hx >= 0x7ff00000) { + *n = 1; + if (((hx & 0xfffff) | lx) != 0) + return (x + x); /* NaN */ + else + return ((xsb == 0) ? x : 0.0); + /* exp(+-inf)={inf,0} */ + } + *n = (xsb == 0) ? 50000 : -50000; + return (one + ln2LO[1] * ln2LO[1]); /* generate inexact */ + } + + *n = 0; + /* argument reduction */ + if (hx > 0x3fd62e42) { /* if |x| > 0.5 ln2 */ + if (hx < 0x3FF0A2B2) { /* and |x| < 1.5 ln2 */ + hi = x - ln2HI[xsb]; + lo = ln2LO[xsb]; + k = 1 - xsb - xsb; + } else { + k = (int) (invln2 * x + halF[xsb]); + t = k; + hi = x - t * ln2HI[0]; + /* t*ln2HI is exact for t<2**20 */ + lo = t * ln2LO[0]; + } + x = hi - lo; + *n = k; + } else if (hx < 0x3e300000) { /* when |x|<2**-28 */ + return (one + x); + } else + k = 0; + + /* x is now in primary range */ + t = x * x; + c = x - t * (P1 + t * (P2 + t * (P3 + t * (P4 + t * P5)))); + if (k == 0) + return (one - ((x * c) / (c - 2.0) - x)); + else { + t = one - ((lo - (x * c) / (2.0 - c)) - hi); + if (k > 128) { + t *= two128; + *n = k - 128; + } else if (k > 0) { + HI_WORD(t) += (k << 20); + *n = 0; + } + return (t); + } +} diff --git a/usr/src/lib/libm/common/complex/k_cexpl.c b/usr/src/lib/libm/common/complex/k_cexpl.c new file mode 100644 index 0000000000..5db611d812 --- /dev/null +++ b/usr/src/lib/libm/common/complex/k_cexpl.c @@ -0,0 +1,283 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ + +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2006 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +/* INDENT OFF */ +/* + * long double __k_cexpl(long double x, int *n); + * Returns the exponential of x in the form of 2**n * y, y=__k_cexpl(x,&n). + * + * 1. Argument Reduction: given the input x, find r and integer k + * and j such that + * x = (32k+j)*ln2 + r, |r| <= (1/64)*ln2 . + * + * 2. expl(x) = 2^k * (2^(j/32) + 2^(j/32)*expm1(r)) + * Note: + * a. expm1(r) = (2r)/(2-R), R = r - r^2*(t1 + t2*r^2) + * b. 2^(j/32) is represented as + * exp2_32_hi[j]+exp2_32_lo[j] + * where + * exp2_32_hi[j] = 2^(j/32) rounded + * exp2_32_lo[j] = 2^(j/32) - exp2_32_hi[j]. + * + * Special cases: + * expl(INF) is INF, expl(NaN) is NaN; + * expl(-INF)= 0; + * for finite argument, only expl(0)=1 is exact. + * + * Accuracy: + * according to an error analysis, the error is always less than + * an ulp (unit in the last place). + * + * Misc. info. + * When |x| is really big, say |x| > 1000000, the accuracy + * is not important because the ultimate result will over or under + * flow. So we will simply replace n = 1000000 and r = 0.0. For + * moderate size x, according to an error analysis, the error is + * always less than 1 ulp (unit in the last place). + * + * Constants: + * Only decimal values are given. We assume that the compiler will convert + * from decimal to binary accurately enough to produce the correct + * hexadecimal values. + */ +/* INDENT ON */ + +#include "libm.h" /* __k_cexpl */ +#include "complex_wrapper.h" /* HI_XWORD */ + +/* INDENT OFF */ +/* ln2/32 = 0.0216608493924982909192885037955680177523593791987579766912713 */ +#if defined(__x86) +static const long double + /* 43 significant bits, 21 trailing zeros */ +ln2_32hi = 2.166084939249657281834515742957592010498046875e-2L, +ln2_32lo = 1.7181009433463659920976473789104487579766912713e-15L; +static const long double exp2_32_hi[] = { /* exp2_32[j] = 2^(j/32) */ + 1.0000000000000000000000000e+00L, + 1.0218971486541166782081522e+00L, + 1.0442737824274138402382006e+00L, + 1.0671404006768236181297224e+00L, + 1.0905077326652576591003302e+00L, + 1.1143867425958925362894369e+00L, + 1.1387886347566916536971221e+00L, + 1.1637248587775775137938619e+00L, + 1.1892071150027210666875674e+00L, + 1.2152473599804688780476325e+00L, + 1.2418578120734840485256747e+00L, + 1.2690509571917332224885722e+00L, + 1.2968395546510096659215822e+00L, + 1.3252366431597412945939118e+00L, + 1.3542555469368927282668852e+00L, + 1.3839098819638319548151403e+00L, + 1.4142135623730950487637881e+00L, + 1.4451808069770466200253470e+00L, + 1.4768261459394993113155431e+00L, + 1.5091644275934227397133885e+00L, + 1.5422108254079408235859630e+00L, + 1.5759808451078864864006862e+00L, + 1.6104903319492543080837174e+00L, + 1.6457554781539648445110730e+00L, + 1.6817928305074290860378350e+00L, + 1.7186192981224779156032914e+00L, + 1.7562521603732994831094730e+00L, + 1.7947090750031071864148413e+00L, + 1.8340080864093424633989166e+00L, + 1.8741676341102999013002103e+00L, + 1.9152065613971472938202589e+00L, + 1.9571441241754002689657438e+00L, +}; +static const long double exp2_32_lo[] = { + 0.0000000000000000000000000e+00L, + 2.6327965667180882569382524e-20L, + 8.3765863521895191129661899e-20L, + 3.9798705777454504249209575e-20L, + 1.0668046596651558640993042e-19L, + 1.9376009847285360448117114e-20L, + 6.7081819456112953751277576e-21L, + 1.9711680502629186462729727e-20L, + 2.9932584438449523689104569e-20L, + 6.8887754153039109411061914e-20L, + 6.8002718741225378942847820e-20L, + 6.5846917376975403439742349e-20L, + 1.2171958727511372194876001e-20L, + 3.5625253228704087115438260e-20L, + 3.1129551559077560956309179e-20L, + 5.7519192396164779846216492e-20L, + 3.7900651177865141593101239e-20L, + 1.1659262405698741798080115e-20L, + 7.1364385105284695967172478e-20L, + 5.2631003710812203588788949e-20L, + 2.6328853788732632868460580e-20L, + 5.4583950085438242788190141e-20L, + 9.5803254376938269960718656e-20L, + 7.6837733983874245823512279e-21L, + 2.4415965910835093824202087e-20L, + 2.6052966871016580981769728e-20L, + 2.6876456344632553875309579e-21L, + 1.2861930155613700201703279e-20L, + 8.8166633394037485606572294e-20L, + 2.9788615389580190940837037e-20L, + 5.2352341619805098677422139e-20L, + 5.2578463064010463732242363e-20L, +}; +#else /* sparc */ +static const long double + /* 0x3FF962E4 2FEFA39E F35793C7 00000000 */ +ln2_32hi = 2.166084939249829091928849858592451515688e-2L, +ln2_32lo = 5.209643502595475652782654157501186731779e-27L; +static const long double exp2_32_hi[] = { /* exp2_32[j] = 2^(j/32) */ + 1.000000000000000000000000000000000000000e+0000L, + 1.021897148654116678234480134783299439782e+0000L, + 1.044273782427413840321966478739929008785e+0000L, + 1.067140400676823618169521120992809162607e+0000L, + 1.090507732665257659207010655760707978993e+0000L, + 1.114386742595892536308812956919603067800e+0000L, + 1.138788634756691653703830283841511254720e+0000L, + 1.163724858777577513813573599092185312343e+0000L, + 1.189207115002721066717499970560475915293e+0000L, + 1.215247359980468878116520251338798457624e+0000L, + 1.241857812073484048593677468726595605511e+0000L, + 1.269050957191733222554419081032338004715e+0000L, + 1.296839554651009665933754117792451159835e+0000L, + 1.325236643159741294629537095498721674113e+0000L, + 1.354255546936892728298014740140702804343e+0000L, + 1.383909881963831954872659527265192818002e+0000L, + 1.414213562373095048801688724209698078570e+0000L, + 1.445180806977046620037006241471670905678e+0000L, + 1.476826145939499311386907480374049923924e+0000L, + 1.509164427593422739766019551033193531420e+0000L, + 1.542210825407940823612291862090734841307e+0000L, + 1.575980845107886486455270160181905008906e+0000L, + 1.610490331949254308179520667357400583459e+0000L, + 1.645755478153964844518756724725822445667e+0000L, + 1.681792830507429086062250952466429790080e+0000L, + 1.718619298122477915629344376456312504516e+0000L, + 1.756252160373299483112160619375313221294e+0000L, + 1.794709075003107186427703242127781814354e+0000L, + 1.834008086409342463487083189588288856077e+0000L, + 1.874167634110299901329998949954446534439e+0000L, + 1.915206561397147293872611270295830887850e+0000L, + 1.957144124175400269018322251626871491190e+0000L, +}; + +static const long double exp2_32_lo[] = { + +0.000000000000000000000000000000000000000e+0000L, + +1.805067874203309547455733330545737864651e-0035L, + -9.374520292280427421957567419730832143843e-0035L, + -1.596968447292758770712909630231499971233e-0035L, + +9.112493410125022978511686101672486662119e-0035L, + -6.504228206978548287230374775259388710985e-0035L, + -8.148468844525851137325691767488155323605e-0035L, + -5.066214576721800313372330745142903350963e-0035L, + -1.359830974688816973749875638245919118924e-0035L, + +9.497427635563196470307710566433246597109e-0035L, + -3.283170523176998601615065965333915261932e-0036L, + -5.017235709387190410290186530458428950862e-0035L, + -2.391474797689109171622834301602640139258e-0035L, + -8.350571357633908815298890737944083853080e-0036L, + +7.036756889073265042421737190671876440729e-0035L, + -5.182484853064646457536893018566956189817e-0035L, + +9.422242548621832065692116736394064879758e-0035L, + -3.967500825398862309167306130216418281103e-0035L, + +7.143528991563300614523273615092767243521e-0035L, + +1.159871252867985124246517834100444327747e-0035L, + +4.696933478358115495309739213201874466685e-0035L, + -3.386513175995004710799241984999819165197e-0035L, + -8.587318774298247068868655935103874453522e-0035L, + -9.605951548749350503185499362246069088835e-0035L, + +9.609733932128012784507558697141785813655e-0035L, + +6.378397921440028439244761449780848545957e-0035L, + +7.792430785695864249456461125169277701177e-0035L, + +7.361337767588456524131930836633932195088e-0035L, + -6.472995147913347230035214575612170525266e-0035L, + +8.587474417953698694278798062295229624207e-0035L, + +2.371815422825174835691651228302690977951e-0035L, + -3.026891682096118773004597373421900314256e-0037L, +}; +#endif + +static const long double + one = 1.0L, + two = 2.0L, + ln2_64 = 1.083042469624914545964425189778400898568e-2L, + invln2_32 = 4.616624130844682903551758979206054839765e+1L; + +/* rational approximation coeffs for [-(ln2)/64,(ln2)/64] */ +static const long double + t1 = 1.666666666666666666666666666660876387437e-1L, + t2 = -2.777777777777777777777707812093173478756e-3L, + t3 = 6.613756613756613482074280932874221202424e-5L, + t4 = -1.653439153392139954169609822742235851120e-6L, + t5 = 4.175314851769539751387852116610973796053e-8L; +/* INDENT ON */ + +long double +__k_cexpl(long double x, int *n) { + int hx, ix, j, k; + long double t, r; + + *n = 0; + hx = HI_XWORD(x); + ix = hx & 0x7fffffff; + if (hx >= 0x7fff0000) + return (x + x); /* NaN of +inf */ + if (((unsigned) hx) >= 0xffff0000) + return (-one / x); /* NaN or -inf */ + if (ix < 0x3fc30000) + return (one + x); /* |x|<2^-60 */ + if (hx > 0) { + if (hx > 0x401086a0) { /* x > 200000 */ + *n = 200000; + return (one); + } + k = (int) (invln2_32 * (x + ln2_64)); + } else { + if (ix > 0x401086a0) { /* x < -200000 */ + *n = -200000; + return (one); + } + k = (int) (invln2_32 * (x - ln2_64)); + } + j = k & 0x1f; + *n = k >> 5; + t = (long double) k; + x = (x - t * ln2_32hi) - t * ln2_32lo; + t = x * x; + r = (x - t * (t1 + t * (t2 + t * (t3 + t * (t4 + t * t5))))) - two; + x = exp2_32_hi[j] - ((exp2_32_hi[j] * (x + x)) / r - exp2_32_lo[j]); + k >>= 5; + if (k > 240) { + XFSCALE(x, 240); + *n -= 240; + } else if (k > 0) { + XFSCALE(x, k); + *n = 0; + } + return (x); +} diff --git a/usr/src/lib/libm/common/complex/k_clog_r.c b/usr/src/lib/libm/common/complex/k_clog_r.c new file mode 100644 index 0000000000..6726da456d --- /dev/null +++ b/usr/src/lib/libm/common/complex/k_clog_r.c @@ -0,0 +1,412 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2005 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#include "libm.h" /* __k_clog_r */ +#include "complex_wrapper.h" + +/* INDENT OFF */ +/* + * double __k_clog_r(double x, double y, double *e); + * + * Compute real part of complex natural logarithm of x+iy in extra precision + * + * __k_clog_r returns log(hypot(x, y)) with a correction term e. + * + * Accuracy: 70 bits + * + * Method. + * Let Z = x*x + y*y. Z can be normalized as Z = 2^N * z, 1 <= z < 2. + * We further break down z into 1 + zk + zh + zt, where + * zk = K*(2^-7) matches z to 7.5 significant bits, 0 <= K <= 2^(-7)-1 + * zh = (z-zk) rounded to 24 bits + * zt = (z-zk-zh) rounded. + * + * z - (1+zk) (zh+zt) + * Let s = ------------ = ---------------, then + * z + (1+zk) 2(1+zk)+zh+zt + * z + * log(Z) = N*log2 + log(z) = N*log2 + log(1+zk) + log(------) + * 1+zk + * 1+s + * = N*log2 + log(1+zk) + log(---) + * 1-s + * + * 1 3 1 5 + * = N*log2 + log(1+zk) + 2s + -- (2s) + -- (2s) + ... + * 12 80 + * + * Note 1. For IEEE double precision, a seven degree odd polynomial + * 2s + P1*(2s)^3 + P2*(2s)^5 + P3*(2s)^7 + * is generated by a special remez algorithm to + * approx log((1+s)/(1-s)) accurte to 72 bits. + * Note 2. 2s can be computed accurately as s2h+s2t by + * r = 2/((zh+zt)+2(1+zk)) + * s2 = r*(zh+zt) + * s2h = s2 rounded to float; v = 0.5*s2h; + * s2t = r*((((zh-s2h*(1+zk))-v*zh)+zt)-v*zt) + */ +/* INDENT ON */ + +static const double +zero = 0.0, +half = 0.5, +two = 2.0, +two120 = 1.32922799578491587290e+36, /* 2^120 */ +ln2_h = 6.93147180369123816490e-01, /* 3fe62e42 fee00000 */ +ln2_t = 1.90821492927058770002e-10, /* 3dea39ef 35793c76 */ +P1 = .083333333333333351554108717377986202224765262191125, +P2 = .01249999999819227552330700574633767185896464873834375, +P3 = .0022321938458645656605471559987512516234702284287265625; + +/* +* T[2k, 2k+1] = log(1+k*2^-7) for k = 0, ..., 2^7 - 1, +* with T[2k] * 2^40 is an int +*/ + +static const double TBL_log1k[] = { +0.00000000000000000000e+00, 0.00000000000000000000e+00, +7.78214044203195953742e-03, 2.29894100462035112076e-14, +1.55041865355087793432e-02, 4.56474807636434698847e-13, +2.31670592811497044750e-02, 3.84673753843363762372e-13, +3.07716586667083902285e-02, 4.52981425779092882775e-14, +3.83188643018002039753e-02, 3.36395218465265063278e-13, +4.58095360309016541578e-02, 3.92549008891706208826e-13, +5.32445145181554835290e-02, 6.56799336898521766515e-13, +6.06246218158048577607e-02, 6.29984819938331143924e-13, +6.79506619080711971037e-02, 4.36552290856295281946e-13, +7.52234212368421140127e-02, 7.45411685916941618656e-13, +8.24436692109884461388e-02, 8.61451293608781447223e-14, +8.96121586893059429713e-02, 3.81189648692113819551e-13, +9.67296264579999842681e-02, 5.51128027471986918274e-13, +1.03796793680885457434e-01, 7.58107392301637643358e-13, +1.10814366339582193177e-01, 7.07921017612766061755e-13, +1.17783035655520507134e-01, 8.62947404296943765415e-13, +1.24703478500123310369e-01, 8.33925494898414856118e-13, +1.31576357788617315236e-01, 1.01957352237084734958e-13, +1.38402322858382831328e-01, 7.36304357708705134617e-13, +1.45182009843665582594e-01, 8.32314688404647202319e-13, +1.51916042025732167531e-01, 1.09807540998552379211e-13, +1.58605030175749561749e-01, 8.89022343972466269900e-13, +1.65249572894936136436e-01, 3.71026439894104998399e-13, +1.71850256926518341061e-01, 1.40881279371111350341e-13, +1.78407657472234859597e-01, 5.83437522462346671423e-13, +1.84922338493379356805e-01, 6.32635858668445232946e-13, +1.91394852999110298697e-01, 5.19155912393432989209e-13, +1.97825743329303804785e-01, 6.16075577558872326221e-13, +2.04215541428311553318e-01, 3.79338185766902218086e-13, +2.10564769106895255391e-01, 4.54382278998146218219e-13, +2.16873938300523150247e-01, 9.12093724991498410553e-14, +2.23143551314024080057e-01, 1.85675709597960106615e-13, +2.29374101064422575291e-01, 4.23254700234549300166e-13, +2.35566071311950508971e-01, 8.16400106820959292914e-13, +2.41719936886511277407e-01, 6.33890736899755317832e-13, +2.47836163904139539227e-01, 4.41717553713155466566e-13, +2.53915209980732470285e-01, 2.30973852175869394892e-13, +2.59957524436686071567e-01, 2.39995404842117353465e-13, +2.65963548496984003577e-01, 1.53937761744554075681e-13, +2.71933715483100968413e-01, 5.40790418614551497411e-13, +2.77868451003087102436e-01, 3.69203750820800887027e-13, +2.83768173129828937817e-01, 8.15660529536291275782e-13, +2.89633292582948342897e-01, 9.43339818951269030846e-14, +2.95464212893421063200e-01, 4.14813187042585679830e-13, +3.01261330577290209476e-01, 8.71571536970835103739e-13, +3.07025035294827830512e-01, 8.40315630479242455758e-14, +3.12755710003330023028e-01, 5.66865358290073900922e-13, +3.18453731118097493891e-01, 4.37121919574291444278e-13, +3.24119468653407238889e-01, 8.04737201185162774515e-13, +3.29753286371669673827e-01, 7.98307987877335024112e-13, +3.35355541920762334485e-01, 3.75495772572598557174e-13, +3.40926586970454081893e-01, 1.39128412121975659358e-13, +3.46466767346100823488e-01, 1.07757430375726404546e-13, +3.51976423156884266064e-01, 2.93918591876480007730e-13, +3.57455888921322184615e-01, 4.81589611172320539489e-13, +3.62905493689140712377e-01, 2.27740761140395561986e-13, +3.68325561158599157352e-01, 1.08495696229679121506e-13, +3.73716409792905324139e-01, 6.78756682315870616582e-13, +3.79078352934811846353e-01, 1.57612037739694350287e-13, +3.84411698910298582632e-01, 3.34571026954408237380e-14, +3.89716751139530970249e-01, 4.94243121138567024911e-13, +3.94993808240542421117e-01, 3.26556988969071456956e-13, +4.00243164126550254878e-01, 4.62452051668403792833e-13, +4.05465108107819105498e-01, 3.45276479520397708744e-13, +4.10659924984429380856e-01, 8.39005077851830734139e-13, +4.15827895143593195826e-01, 1.17769787513692141889e-13, +4.20969294643327884842e-01, 8.01751287156832458079e-13, +4.26084395310681429692e-01, 2.18633432932159103190e-13, +4.31173464818130014464e-01, 2.41326394913331314894e-13, +4.36236766774527495727e-01, 3.90574622098307022265e-13, +4.41274560804231441580e-01, 6.43787909737320689684e-13, +4.46287102628048160113e-01, 3.71351419195920213229e-13, +4.51274644138720759656e-01, 7.37825488412103968058e-13, +4.56237433480964682531e-01, 6.22911850193784704748e-13, +4.61175715121498797089e-01, 6.71369279138460114513e-13, +4.66089729924533457961e-01, 6.57665976858006147528e-14, +4.70979715218163619284e-01, 6.27393263311115598424e-13, +4.75845904869856894948e-01, 1.07019317621142549209e-13, +4.80688529345570714213e-01, 1.81193463664411114729e-13, +4.85507815781602403149e-01, 9.84046527823262695501e-14, +4.90303988044615834951e-01, 5.78003198945402769376e-13, +4.95077266797125048470e-01, 7.26466128212511528295e-13, +4.99827869555701909121e-01, 7.47420700205478712293e-13, +5.04556010751912253909e-01, 4.83033149495532022300e-13, +5.09261901789614057634e-01, 1.93889170049107088943e-13, +5.13945751101346104406e-01, 8.88212395185718544720e-13, +5.18607764207445143256e-01, 6.00488896640545761201e-13, +5.23248143764249107335e-01, 2.98729182044413286731e-13, +5.27867089620485785417e-01, 3.56599696633478298092e-13, +5.32464798869114019908e-01, 3.57823965912763837621e-13, +5.37041465896436420735e-01, 4.47233831757482468946e-13, +5.41597282432121573947e-01, 6.22797629172251525649e-13, +5.46132437597407260910e-01, 7.28389472720657362987e-13, +5.50647117952394182794e-01, 2.68096466152116723636e-13, +5.55141507539701706264e-01, 7.99886451312335479470e-13, +5.59615787935399566777e-01, 2.31194938380053776320e-14, +5.64070138284478161950e-01, 3.24804121719935740729e-13, +5.68504735351780254859e-01, 8.88457219261483317716e-13, +5.72919753561109246220e-01, 6.76262872317054154667e-13, +5.77315365034337446559e-01, 4.86157758891509033842e-13, +5.81691739634152327199e-01, 4.70155322075549811780e-13, +5.86049045003164792433e-01, 4.13416470738355643357e-13, +5.90387446602107957006e-01, 6.84176364159146659095e-14, +5.94707107746216934174e-01, 4.75855340044306376333e-13, +5.99008189645246602595e-01, 8.36796786747576938145e-13, +6.03290851438032404985e-01, 5.18573553063418286042e-14, +6.07555250224322662689e-01, 2.19132812293400917731e-13, +6.11801541105705837253e-01, 2.87066276408616768331e-13, +6.16029877214714360889e-01, 7.99658758518543977451e-13, +6.20240409751204424538e-01, 6.53104313776336534177e-13, +6.24433288011459808331e-01, 4.33692711555820529733e-13, +6.28608659421843185555e-01, 5.30952189118357790115e-13, +6.32766669570628437214e-01, 4.09392332186786656392e-13, +6.36907462236194987781e-01, 8.74243839148582888557e-13, +6.41031179420679109171e-01, 2.52181884568428814231e-13, +6.45137961372711288277e-01, 8.73413388168702670246e-13, +6.49227946624705509748e-01, 4.04309142530119209805e-13, +6.53301272011958644725e-01, 7.86994033233553225797e-13, +6.57358072708120744210e-01, 2.39285932153437645135e-13, +6.61398482245203922503e-01, 1.61085757539324585156e-13, +6.65422632544505177066e-01, 5.85271884362515112697e-13, +6.69430653942072240170e-01, 5.57027128793880294600e-13, +6.73422675211440946441e-01, 7.25773856816637653180e-13, +6.77398823590920073912e-01, 8.86066898134949155668e-13, +6.81359224807238206267e-01, 6.64862680714687006264e-13, +6.85304003098281100392e-01, 6.38316151706465171657e-13, +6.89233281238557538018e-01, 2.51442307283760746611e-13, +}; + +/* + * Compute N*log2 + log(1+zk+zh+zt) in extra precision + */ +static double k_log_NKz(int N, int K, double zh, double *zt) +{ + double y, r, w, s2, s2h, s2t, t, zk, v, P; + + ((int *)&zk)[HIWORD] = 0x3ff00000 + (K << 13); + ((int *)&zk)[LOWORD] = 0; + t = zh + (*zt); + r = two / (t + two * zk); + s2h = s2 = r * t; + ((int *)&s2h)[LOWORD] &= 0xe0000000; + v = half * s2h; + w = s2 * s2; + s2t = r * ((((zh - s2h * zk) - v * zh) + (*zt)) - v * (*zt)); + P = s2t + (w * s2) * ((P1 + w * P2) + (w * w) * P3); + P += N * ln2_t + TBL_log1k[K + K + 1]; + t = N*ln2_h + TBL_log1k[K+K]; + y = t + (P + s2h); + P -= ((y - t) - s2h); + *zt = P; + return (y); +} + +double +__k_clog_r(double x, double y, double *er) +{ + double t1, t2, t3, t4, tk, z, wh, w, zh, zk; + int n, k, ix, iy, iz, nx, ny, nz, i, j; + unsigned lx, ly; + + ix = (((int *)&x)[HIWORD]) & ~0x80000000; + lx = ((unsigned *)&x)[LOWORD]; + iy = (((int *)&y)[HIWORD]) & ~0x80000000; + ly = ((unsigned *)&y)[LOWORD]; + y = fabs(y); x = fabs(x); + if (ix < iy || (ix == iy && lx < ly)) { /* force x >= y */ + tk = x; x = y; y = tk; + n = ix, ix = iy; iy = n; + n = lx, lx = ly; ly = n; + } + *er = zero; + nx = ix >> 20; ny = iy >> 20; + if (nx >= 0x7ff) { /* x or y is Inf or NaN */ + if (ISINF(ix, lx)) + return (x); + else if (ISINF(iy, ly)) + return (y); + else + return (x+y); + } +/* + * for tiny y (double y < 2^-35, extended y < 2^-46, quad y < 2^-70): + * log(sqrt(1+y^2)) = (y^2)/2 - (y^4)/8 + ... ~= (y^2)/2 + */ + if ((((ix - 0x3ff00000) | lx) == 0) && ny < (0x3ff - 35)) { + t2 = y * y; + if (ny >= 565) { /* compute er = tail of t2 */ + ((int *)&wh)[HIWORD] = iy; + ((unsigned *)&wh)[LOWORD] = ly & 0xf8000000; + *er = half * ((y - wh) * (y + wh) - (t2 - wh * wh)); + } + return (half * t2); + } +/* + * x or y is subnormal or zero + */ + if (nx == 0) { + if ((ix | lx) == 0) + return (-1.0 / x); + else { + x *= two120; + y *= two120; + ix = ((int *)&x)[HIWORD]; + lx = ((unsigned *)&x)[LOWORD]; + iy = ((int *)&y)[HIWORD]; + ly = ((unsigned *)&y)[LOWORD]; + nx = (ix >> 20) - 120; + ny = (iy >> 20) - 120; + /* guard subnormal flush to 0 */ + if ((ix | lx) == 0) + return (-1.0 / x); + } + } else if (ny == 0) { /* y subnormal, scale it */ + y *= two120; + iy = ((int *)&y)[HIWORD]; + ly = ((unsigned *)&y)[LOWORD]; + ny = (iy >> 20) - 120; + } + n = nx - ny; +/* + * return log(x) when y is zero or x >> y so that + * log(x) ~ log(sqrt(x*x+y*y)) to 27 extra bits + * (n > 62 for double, 78 for i386 extended, 122 for quad) + */ + if (n > 62 || (iy | ly) == 0) { + i = (0x000fffff & ix) | 0x3ff00000; /* normalize x */ + ((int *)&x)[HIWORD] = i; + i += 0x1000; + ((int *)&zk)[HIWORD] = i & 0xffffe000; + ((int *)&zk)[LOWORD] = 0; /* zk matches 7.5 bits of x */ + z = x - zk; + zh = (double)((float)z); + i >>= 13; + k = i & 0x7f; /* index of zk */ + n = nx - 0x3ff; + *er = z - zh; + if (i >> 17) { /* if zk = 2.0, adjust scaling */ + n += 1; + zh *= 0.5; *er *= 0.5; + } + w = k_log_NKz(n, k, zh, er); + } else { +/* + * compute z = x*x + y*y + */ + ix = (ix & 0xfffff) | 0x3ff00000; + iy = (iy & 0xfffff) | (0x3ff00000 - (n << 20)); + ((int *)&x)[HIWORD] = ix; ((int *)&y)[HIWORD] = iy; + t1 = x * x; t2 = y * y; + j = ((lx >> 26) + 1) >> 1; + ((int *)&wh)[HIWORD] = ix + (j >> 5); + ((unsigned *)&wh)[LOWORD] = (j << 27); + z = t1+t2; +/* + * higher precision simulation x*x = t1 + t3, y*y = t2 + t4 + */ + tk = wh - x; + t3 = tk * tk - (two * wh * tk - (wh * wh - t1)); + j = ((ly >> 26) + 1) >> 1; + ((int *)&wh)[HIWORD] = iy + (j >> 5); + ((unsigned *)&wh)[LOWORD] = (j << 27); + tk = wh - y; + t4 = tk * tk - (two * wh * tk - (wh * wh - t2)); +/* + * find zk matches z to 7.5 bits + */ + nx -= 0x3ff; + iz = ((int *)&z)[HIWORD] + 0x1000; + k = (iz >> 13) & 0x7f; + nz = (iz >> 20) - 0x3ff; + ((int *)&zk)[HIWORD] = iz & 0xffffe000; + ((int *)&zk)[LOWORD] = 0; +/* + * order t1,t2,t3,t4 according to their size + */ + if (t2 >= fabs(t3)) { + if (fabs(t3) < fabs(t4)) { + wh = t3; t3 = t4; t4 = wh; + } + } else { + wh = t2; t2 = t3; t3 = wh; + } +/* + * higher precision simulation: x * x + y * y = t1 + t2 + t3 + t4 + * = zk (7 bits) + zh (24 bits) + *er (tail) and call k_log_NKz + */ + tk = t1 - zk; + zh = ((tk + t2) + t3) + t4; + ((int *)&zh)[LOWORD] &= 0xe0000000; + w = fabs(zh); + if (w >= fabs(t2)) + *er = (((tk - zh) + t2) + t3) + t4; + else { + if (n == 0) { + wh = half * zk; + wh = (t1 - wh) - (wh - t2); + } else + wh = tk + t2; + if (w >= fabs(t3)) + *er = ((wh - zh) + t3) + t4; + else { + z = t3; + t3 += t4; + t4 -= t3 - z; + if (w >= fabs(t3)) + *er = ((wh - zh) + t3) + t4; + else + *er = ((wh + t3) - zh) + t4; + } + } + if (nz == 3) {zh *= 0.125; *er *= 0.125; } + if (nz == 2) {zh *= 0.25; *er *= 0.25; } + if (nz == 1) {zh *= half; *er *= half; } + nz += nx + nx; + w = half * k_log_NKz(nz, k, zh, er); + *er *= half; + } + return (w); +} diff --git a/usr/src/lib/libm/common/complex/k_clog_rl.c b/usr/src/lib/libm/common/complex/k_clog_rl.c new file mode 100644 index 0000000000..53eaa88ce4 --- /dev/null +++ b/usr/src/lib/libm/common/complex/k_clog_rl.c @@ -0,0 +1,645 @@ +/* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License (the "License"). + * You may not use this file except in compliance with the License. + * + * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE + * or http://www.opensolaris.org/os/licensing. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at usr/src/OPENSOLARIS.LICENSE. + * If applicable, add the following below this CDDL HEADER, with the + * fields enclosed by brackets "[]" replaced with your own identifying + * information: Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + */ +/* + * Copyright 2011 Nexenta Systems, Inc. All rights reserved. + */ +/* + * Copyright 2005 Sun Microsystems, Inc. All rights reserved. + * Use is subject to license terms. + */ + +#include "libm.h" /* __k_clog_rl */ +#include "complex_wrapper.h" +#include "longdouble.h" + +/* INDENT OFF */ +/* + * long double __k_clog_rl(long double x, long double y, long double *e); + * + * Compute real part of complex natural logarithm of x+iy in extra precision + * + * __k_clog_rl returns log(hypot(x, y)) with a correction term e. + * + * Accuracy: quad 140 bits, intel extended 91 bits. + * + * Method. + * Assume X > Y >= 0 . Let X = 2**nx * x, Y = 2**nx * y, where 1 <= x < 2. + * Let Z = X*X + Y*Y. Then Z = 2**(nx+nx) * z, where z = x*x + y*y. + * Note that z < 8. + * Let Z = x*x + y*y. Z can be normalized as Z = 2**N * z, 1 <= z < 2. + * We further break down z into 1 + zk + zh + zt, where + * zk = K*(2**-7) matches z to 7.5 significant bits, 0 <= K <= 2**(-7)-1 + * zh = (z-zk) rounded to half of the current significant bits + * zt = (z-zk-zh) rounded. + * + * z - (1+zk) (zh+zt) + * Let s = ------------ = ---------------, then + * z + (1+zk) 2(1+zk)+zh+zt + * z + * log(Z) = N*log2 + log(z) = N*log2 + log(1+zk) + log(------) + * 1+zk + * 1+s + * = N * log2 + log(1 +zk) + log(---) + * 1-s + * + * 3 5 + * = N*log2 + log(1+zk) + 2s + 1/12(2s) + 1/80(2s) + ... + * + * + * Note 1. For IEEE double precision, a fifteen degree odd polynomial + * 2s + P1*(2s)^3 + P2*(2s)^5 + P3*(2s)^7 + ... + P7*(2s)^15 + * is generated by a special remez algorithm to + * approx log((1+s)/(1-s)) accurte to 145 bits. + * Note 2. 2s can be computed accurately as s2h+s2t by + * r = 2/((zh+zt)+2(1+zk)) + * s2 = r*(zh+zt) + * s2h = s2 rounded to double; v = 0.5*s2h; + * s2t = r*((((zh-s2h*(1+zk))-v*zh)+zt)-v*zt) + */ +/* INDENT ON */ + +static const long double +zero = 0.0L, +half = 0.5L, +two = 2.0L, +two240 = 1.7668470647783843295832975007429185158274839e+72L, /* 2^240 */ + +/* first 48 bits of ln2 */ +ln2_h = 0.693147180559943620892227045260369777679443359375L, +ln2_t = 1.68852500507619780679039605677498525525412068e-15L, +P1 = .083333333333333333333333333333333333341023785768375L, +P2 = .01249999999999999999999999999999679085402075766159375L, +P3 = .002232142857142857142857143310092047621284490564671875L, +P4 = .00043402777777777777774746781319264872413156956512109375L, +P5 = .0000887784090909101756336594019277185263940665468935546875L, +P6 = .000018780048055589639895360927834628371268354778446533203125L, +P7 = .000004069227854328982921366736003458838031087153635406494140625L; + +/* + * T[2k, 2k+1] = log(1+k*2**-7) for k = 0, ..., 2**7 - 1, + * with T[2k] * 2^48 is an int + */ + +static const long double TBL_log1k[] = { +0.0000000000000000000000000000000000000000e+00L, +0.0000000000000000000000000000000000000000e+00L, +7.7821404420532758194894995540380477905273e-03L, +1.6731279734005070987158875984584325351222e-15L, +1.5504186535963526694104075431823730468750e-02L, +1.7274567499706106231054091184928671990316e-15L, +2.3167059281533397552266251295804977416992e-02L, +9.8067653290966648493916241687661877474892e-16L, +3.0771658666751022792595904320478439331055e-02L, +2.6655784323032762937247606420524589813624e-15L, +3.8318864302134159061097307130694389343262e-02L, +2.4401326580179931029010027013316092332340e-15L, +4.5809536031292452662455616518855094909668e-02L, +1.7505042236510958082472042641283104263139e-15L, +5.3244514518809182845870964229106903076172e-02L, +3.1000199992295574218738634002122149891138e-15L, +6.0624621816433688081815489567816257476807e-02L, +1.1544987906424726040058093958345197512800e-15L, +6.7950661908504628172522643581032752990723e-02L, +3.1212220426341915966610439115772728417386e-15L, +7.5223421237584631171557703055441379547119e-02L, +2.8945270476369282210350897509258766743153e-15L, +8.2443669211073711267090402543544769287109e-02L, +8.8000106966612476303662698634483335676886e-16L, +8.9612158689686083334891009144484996795654e-02L, +1.0492850604602339995319895311151740799226e-15L, +9.6729626458550654888313147239387035369873e-02L, +4.5740725790924807640164516707244620870662e-16L, +1.0379679368164218544734467286616563796997e-01L, +1.3793787171308978090503366050174239822054e-15L, +1.1081436634028918319927470292896032333374e-01L, +9.3099553146639425160476473362380086036919e-16L, +1.1778303565638026384476688690483570098877e-01L, +3.1906940272225656860040797111813146690890e-15L, +1.2470347850095464536934741772711277008057e-01L, +2.5904940590976537504984110469214193890052e-15L, +1.3157635778871679121948545798659324645996e-01L, +2.4813692306707028899159917911012100567219e-15L, +1.3840232285911824305912887211889028549194e-01L, +8.9262619700148275890190121571708972000380e-16L, +1.4518200984449691759436973370611667633057e-01L, +9.7968756533003444764719201050911636480025e-16L, +1.5191604202583874894116888754069805145264e-01L, +3.2261306345373561864598749471119213018106e-15L, +1.5860503017663774016909883357584476470947e-01L, +8.4392427234104999681053621980394827998735e-16L, +1.6524957289530561865831259638071060180664e-01L, +1.5442172988528965297119225948270579746101e-15L, +1.7185025692665689689420105423778295516968e-01L, +2.3254458978918173643097657009894831132739e-15L, +1.7840765747281750464026117697358131408691e-01L, +7.9247913906453736065426776912520942036896e-16L, +1.8492233849401173984006163664162158966064e-01L, +2.5282384195601762803134514624610774126020e-16L, +1.9139485299962899489401024766266345977783e-01L, +4.5971528855989864541366920731297729269228e-16L, +1.9782574332991842425144568551331758499146e-01L, +1.4561111263856836438840838027526567191527e-15L, +2.0421554142868814096800633706152439117432e-01L, +2.7505358140491347148810394262840919337709e-15L, +2.1056476910734645002776233013719320297241e-01L, +3.1876417904825951583107481283088861928977e-15L, +2.1687393830061196808856038842350244522095e-01L, +2.3915305291373208450532580201045871599499e-15L, +2.2314355131420882116799475625157356262207e-01L, +9.3459830033405826094075253077304795996257e-16L, +2.2937410106484534821902343537658452987671e-01L, +4.8177245728966955534167425511952551974164e-16L, +2.3556607131276408040321257431060075759888e-01L, +2.8286743756446304426525380844720043381780e-15L, +2.4171993688714366044223424978554248809814e-01L, +1.5077020732661279714120052415509585052975e-15L, +2.4783616390458007572306087240576744079590e-01L, +1.1810575418933407573072030113600980623171e-15L, +2.5391520998096339667426946107298135757446e-01L, +4.7463053836833625309891834934881898560705e-17L, +2.5995752443692410338371701072901487350464e-01L, +1.9635883624838132961710716735786266795913e-15L, +2.6596354849713677026556979399174451828003e-01L, +1.1710735561325457988709887923652142233351e-15L, +2.7193371548364098089223261922597885131836e-01L, +7.7793943687530702031066421537496360004376e-16L, +2.7786845100345303194444568362087011337280e-01L, +3.2742419043493025311197092322146237692165e-15L, +2.8376817313064250924981024581938982009888e-01L, +2.0890970909765308649465619266075677112425e-15L, +2.8963329258304071345264674164354801177979e-01L, +1.9634262463138821209582240742801727823629e-15L, +2.9546421289383317798638017848134040832520e-01L, +2.6984003017275736237868564402005801750600e-15L, +3.0126133057816062432721082586795091629028e-01L, +1.1566856647123658045763670687640673680383e-15L, +3.0702503529490954292668902780860662460327e-01L, +2.3191484355127267712770857311812090801833e-15L, +3.1275571000389490450288576539605855941772e-01L, +1.9838833607942922604727420618882220398852e-15L, +3.1845373111853447767316538374871015548706e-01L, +1.3813708182984188944010814590398164268227e-16L, +3.2411946865421015218089451082050800323486e-01L, +1.8239097762496144793489474731253815376404e-15L, +3.2975328637246548169059678912162780761719e-01L, +2.5001238260227991620033344720809714552230e-15L, +3.3535554192113536942088103387504816055298e-01L, +2.4608362985459391180385214539620341910962e-15L, +3.4092658697059263772644044365733861923218e-01L, +5.7257864875612301758921090406373771458003e-16L, +3.4646676734620740489845047704875469207764e-01L, +1.1760200117113770182586341947822306069951e-15L, +3.5197642315717558858523261733353137969971e-01L, +2.5960702148389259075462896448369304790506e-15L, +3.5745588892180180096147523727267980575562e-01L, +1.9732645342528682246686790561260072184839e-15L, +3.6290549368936808605212718248367309570312e-01L, +3.6708569716349381675043725477739939978160e-16L, +3.6832556115870573876236448995769023895264e-01L, +1.9142858656640927085879445412821643247628e-15L, +3.7371640979358389245135185774415731430054e-01L, +1.8836966497497166619234389157276681281343e-16L, +3.7907835293496816575498087331652641296387e-01L, +1.2926358724723144934459175417385013725801e-15L, +3.8441169891033055705520382616668939590454e-01L, +1.4826795862363146014726140088145939341729e-15L, +3.8971675114002479745067830663174390792847e-01L, +4.1591978529737177695912258866565331189698e-16L, +3.9499380824086571806219581048935651779175e-01L, +3.2600441982258756252505182317625310732365e-15L, +4.0024316412701210765590076334774494171143e-01L, +5.9927342433864738622836851475469574662703e-16L, +4.0546510810816371872533636633306741714478e-01L, +6.6325267674913128171942721503283748008372e-16L, +4.1065992498526782128465129062533378601074e-01L, +5.6464965491255048900165082436455718077885e-16L, +4.1582789514371043537721561733633279800415e-01L, +5.3023611327561856950735176370587227509442e-16L, +4.2096929464412724541944044176489114761353e-01L, +2.3907094267197419048248363335257046791153e-15L, +4.2608439531089814522601955104619264602661e-01L, +1.9178985253285492839728700574592375309985e-15L, +4.3117346481836804628073878120630979537964e-01L, +3.2945784336977492852031005044499611665595e-15L, +4.3623676677491474151793227065354585647583e-01L, +3.3288311090524075754441878570852962903891e-15L, +4.4127456080487448275562201160937547683716e-01L, +7.4673387443005192574852544613692268411229e-16L, +4.4628710262841764233598951250314712524414e-01L, +1.8691966006681165218815050615460959199251e-15L, +4.5127464413945617138779198285192251205444e-01L, +2.4137569004002270899666314791611479063976e-15L, +4.5623743348158640742440184112638235092163e-01L, +1.1869564036970375473975162509216610120281e-15L, +4.6117571512216670726047595962882041931152e-01L, +3.4591075239659690349392915732654828400811e-15L, +4.6608972992459740680715185590088367462158e-01L, +1.8177514673916038857252366108673570603067e-15L, +4.7097971521878889689105562865734100341797e-01L, +2.1156558422273990182479555421331461933366e-15L, +4.7584590486996347635795245878398418426514e-01L, +4.3790725712752039722791012358345927696967e-16L, +4.8068852934575190261057286988943815231323e-01L, +5.0660455855585733988956280680891477171499e-18L, +4.8550781578169832641833636444061994552612e-01L, +2.4813834547127501689550526444948043590905e-15L, +4.9030398804519137456736643798649311065674e-01L, +2.4635829797216592537498738468934647345741e-15L, +4.9507726679784980206022737547755241394043e-01L, +1.7125377372093652812514167461480115600063e-15L, +4.9982786955644797899367404170334339141846e-01L, +1.3508276573735437007500942002018098437396e-15L, +5.0455601075239187025545106735080480575562e-01L, +3.4168028574643873701242268618467347998876e-15L, +5.0926190178980590417268103919923305511475e-01L, +2.0426313938800290907697638200502614622891e-15L, +5.1394575110223428282552049495279788970947e-01L, +3.3975485593321419703400672813719873194659e-17L, +5.1860776420804555186805373523384332656860e-01L, +8.0284923261130955371987633083003284697416e-17L, +5.2324814376454753528378205373883247375488e-01L, +3.0123302517119603836788558832352723470118e-16L, +5.2786708962084105678513878956437110900879e-01L, +1.3283287534282139298545497336570406582397e-15L, +5.3246479886946929127589100971817970275879e-01L, +2.5525980327137419625398485590148417041921e-15L, +5.3704146589688050994482182431966066360474e-01L, +3.1446219074198341716354190061340477078626e-15L, +5.4159728243274329884116014000028371810913e-01L, +1.0727353821639001503808606766770295812627e-15L, +5.4613243759813556721383065450936555862427e-01L, +8.3168566554721843605240702438699163825794e-17L, +5.5064711795266063631970610003918409347534e-01L, +1.6429402420791657293666192255419538448840e-15L, +5.5514150754050106684189813677221536636353e-01L, +5.2587358222274368868380660194332415847228e-16L, +5.5961578793542088305912329815328121185303e-01L, +1.8032117652023735453816330571171114110385e-15L, +5.6407013828480145889443519990891218185425e-01L, +1.5071769490901812785299634348367857600711e-15L, +5.6850473535266843327917740680277347564697e-01L, +2.7879956135806418878792935692629147550413e-16L, +5.7291975356178426181941176764667034149170e-01L, +1.2472733449589795907271346997596471822345e-15L, +5.7731536503482061561953742057085037231445e-01L, +2.9886985746409486460291929160223207644146e-15L, +5.8169173963462128540413687005639076232910e-01L, +1.1971164738836689815783808674399742176950e-15L, +5.8604904500357690722012193873524665832520e-01L, +1.3016839974975520776911897855504474452726e-15L, +5.9038744660217545856539800297468900680542e-01L, +9.1607651870514890975077236127894522134392e-16L, +5.9470710774668944509357970673590898513794e-01L, +3.3444207638397932963480545729233567201211e-15L, +5.9900818964608149030937056522816419601440e-01L, +1.9090722294592334873060460706130642200729e-15L, +6.0329085143808214297678205184638500213623e-01L, +2.1193638031348149256035110177854940281795e-15L, +6.0755525022453937822319858241826295852661e-01L, +2.4172778865703728624133665395876418941354e-15L, +6.1180154110599005434778518974781036376953e-01L, +2.8491821045766810044199163148675291775782e-15L, +6.1602987721551372146677749697118997573853e-01L, +2.9818078843122551067455400545109858745295e-16L, +6.2024040975185457114093878772109746932983e-01L, +2.9577105558448461493874424529516311623184e-15L, +6.2443328801189323939979658462107181549072e-01L, +2.6164274215943360130441858075903119505815e-16L, +6.2860865942237253989333112258464097976685e-01L, +1.5978509770831895426601797458058854400463e-15L, +6.3276666957103699928666173946112394332886e-01L, +8.3025912472904245581515990140161946934461e-16L, +6.3690746223706895534633076749742031097412e-01L, +2.7627416365968377888021629180796328536455e-16L, +6.4103117942092779912854894064366817474365e-01L, +3.4919270523937617243719652995048419893186e-15L, +6.4513796137358170312836591619998216629028e-01L, +2.9985368625799347497396478978681548584217e-15L, +6.4922794662510696639401430729776620864868e-01L, +2.8524968256626075449136225882322854909611e-15L, +6.5330127201274379444839723873883485794067e-01L, +1.8443102186424720390266302263929355424008e-15L, +6.5735807270835877602621621917933225631714e-01L, +1.2541156738040666039091970075936624723645e-15L, +6.6139848224536379461824253667145967483521e-01L, +1.2136419933020381912633127333149145382797e-15L, +6.6542263254508782210905337706208229064941e-01L, +2.6268410392329445778904988886114643307320e-15L, +6.6943065394262646350398426875472068786621e-01L, +2.8037949010021747828222575923191438798877e-15L, +6.7342267521216570003161905333399772644043e-01L, +1.0202663413354670195383104149875619397268e-15L, +6.7739882359180469961756898555904626846313e-01L, +1.4411921136244383020300914304078010801275e-15L, +6.8135922480790256372529256623238325119019e-01L, +5.0522277899333570619054540068138110661023e-16L, +6.8530400309891703614084690343588590621948e-01L, +2.3804032011755313470802014258958896193599e-15L, +6.8923328123880622797514661215245723724365e-01L, +2.7523497677256621466659891416404053623832e-15L, +}; + +/* + * Compute N*log2 + log(1+zk+zh+zt) in extra precision + */ +static long double k_log_NKzl(int N, int K, long double zh, long double *zt) +{ + long double y, r, w, s2, s2h, s2t, t, zk, v, P; + double dzk; + +#if !defined(__x86) + unsigned lx, ly; + int j; +#endif + + ((int *)&dzk)[HIWORD] = 0x3ff00000 + (K << 13); + ((int *)&dzk)[LOWORD] = 0; + t = zh + (*zt); + zk = (long double) dzk; + r = two / (t + two * zk); + s2h = s2 = r * t; +/* split s2 into correctly rounded half */ + +#if defined(__x86) + ((unsigned *)&s2h)[0] = 0; /* 32 bits chopped */ +#else + + lx = ((unsigned *)&s2h)[2]; /* 56 bits rounded */ + j = ((lx >> 24) + 1) >> 1; + ((unsigned *)&s2h)[2] = (j << 25); + lx = ((unsigned *)&s2h)[1]; + ly = lx + (j >> 7); + ((unsigned *)&s2h)[1] = ly; + ((unsigned *)&s2h)[0] += (ly == 0 && lx != 0); + ((unsigned *)&s2h)[3] = 0; +#endif + + v = half * s2h; + w = s2 * s2; + s2t = r * ((((zh - s2h * zk) - v * zh) + (*zt)) - v * (*zt)); + P = s2t + (w * s2) * ((P1 + w * P2) + (w * w) * ((P3 + w * P4) + + (w * w) * (P5 + w * P6 + (w * w) * P7))); + P += N * ln2_t + TBL_log1k[K + K + 1]; + t = N*ln2_h + TBL_log1k[K+K]; + y = t + (P + s2h); + P -= ((y - t) - s2h); + *zt = P; + return (y); +} + +long double +__k_clog_rl(long double x, long double y, long double *er) +{ + long double t1, t2, t3, t4, tk, z, wh, w, zh, zk; + int n, k, ix, iy, iz, nx, ny, nz, i; + double dk; + +#if !defined(__x86) + int j; + unsigned lx, ly; +#endif + + ix = HI_XWORD(x) & ~0x80000000; + iy = HI_XWORD(y) & ~0x80000000; + y = fabsl(y); x = fabsl(x); + if (ix < iy || (ix < 0x7fff0000 && ix == iy && x < y)) { + /* force x >= y */ + tk = x; x = y; y = tk; + n = ix, ix = iy; iy = n; + } + *er = zero; + nx = ix >> 16; ny = iy >> 16; + if (nx >= 0x7fff) { /* x or y is Inf or NaN */ + if (isinfl(x)) + return (x); + else if (isinfl(y)) + return (y); + else + return (x+y); + } +/* + * for tiny y:(double y < 2^-35, extended y < 2^-46, quad y < 2^-70) + * + * log(sqrt(1 + y**2)) = y**2 / 2 - y**4 / 8 + ... = y**2 / 2 + */ +#if defined(__x86) + if (x == 1.0L && ny < (0x3fff - 46)) { +#else + if (x == 1.0L && ny < (0x3fff - 70)) { +#endif + + t2 = y * y; + if (ny >= 8305) { /* compute er = tail of t2 */ + dk = (double) y; + +#if defined(__x86) + ((unsigned *)&dk)[LOWORD] &= 0xfffe0000; +#endif + + wh = (long double) dk; + *er = half * ((y - wh) * (y + wh) - (t2 - wh * wh)); + } + return (half * t2); + } +/* + * x or y is subnormal or zero + */ + if (nx == 0) { + if (x == 0.0L) + return (-1.0L / x); + else { + x *= two240; + y *= two240; + ix = HI_XWORD(x); + iy = HI_XWORD(y); + nx = (ix >> 16) - 240; + ny = (iy >> 16) - 240; + /* guard subnormal flush to 0 */ + if (x == 0.0L) + return (-1.0L / x); + } + } else if (ny == 0) { /* y subnormal, scale it */ + y *= two240; + iy = HI_XWORD(y); + ny = (iy >> 16) - 240; + } + n = nx - ny; +/* + * When y is zero or when x >> y, i.e., n > 62, 78, 122 for DBLE, + * EXTENDED, QUAD respectively, + * log(x) = log(sqrt(x * x + y * y)) to 27 extra bits. + */ + +#if defined(__x86) + if (n > 78 || y == 0.0L) { +#else + if (n > 122 || y == 0.0L) { +#endif + + XFSCALE(x, (0x3fff - (ix >> 16))); + i = ((ix & 0xffff) + 0x100) >> 9; /* 7.5 bits of x */ + zk = 1.0L + ((long double) i) * 0.0078125L; + z = x - zk; + dk = (double)z; + +#if defined(__x86) + ((unsigned *)&dk)[LOWORD] &= 0xfffe0000; +#endif + + zh = (long double)dk; + k = i & 0x7f; /* index of zk */ + n = nx - 0x3fff; + *er = z - zh; + if (i == 0x80) { /* if zk = 2.0, adjust scaling */ + n += 1; + zh *= 0.5L; *er *= 0.5L; + } + w = k_log_NKzl(n, k, zh, er); + } else { +/* + * compute z = x*x + y*y + */ + XFSCALE(x, (0x3fff - (ix >> 16))); + XFSCALE(y, (0x3fff - n - (iy >> 16))); + ix = (ix & 0xffff) | 0x3fff0000; + iy = (iy & 0xffff) | (0x3fff0000 - (n << 16)); + nx -= 0x3fff; + t1 = x * x; t2 = y * y; + wh = x; + +/* split x into correctly rounded half */ +#if defined(__x86) + ((unsigned *)&wh)[0] = 0; /* 32 bits chopped */ +#else + lx = ((unsigned *)&wh)[2]; /* 56 rounded */ + j = ((lx >> 24) + 1) >> 1; + ((unsigned *)&wh)[2] = (j << 25); + lx = ((unsigned *)&wh)[1]; + ly = lx + (j >> 7); + ((unsigned *)&wh)[1] = ly; + ((unsigned *)&wh)[0] += (ly == 0 && lx != 0); + ((unsigned *)&wh)[3] = 0; +#endif + + z = t1+t2; +/* + * higher precision simulation x*x = t1 + t3, y*y = t2 + t4 + */ + tk = wh - x; + t3 = tk * tk - (two * wh * tk - (wh * wh - t1)); + wh = y; + +/* split y into correctly rounded half */ +#if defined(__x86) + ((unsigned *)&wh)[0] = 0; /* 32 bits chopped */ +#else + ly = ((unsigned *)&wh)[2]; /* 56 bits rounded */ + j = ((ly >> 24) + 1) >> 1; + ((unsigned *)&wh)[2] = (j << 25); + lx = ((unsigned *)&wh)[1]; + ly = lx + (j >> 7); + ((unsigned *)&wh)[1] = ly; + ((unsigned *)&wh)[0] += (ly == 0 && lx != 0); + ((unsigned *)&wh)[3] = 0; +#endif + + tk = wh - y; + t4 = tk * tk - (two * wh * tk - (wh * wh - t2)); +/* + * find zk matches z to 7.5 bits + */ + iz = HI_XWORD(z); + k = ((iz & 0xffff) + 0x100) >> 9; /* 7.5 bits of x */ + nz = (iz >> 16) - 0x3fff + (k >> 7); + k &= 0x7f; + zk = 1.0L + ((long double) k) * 0.0078125L; + if (nz == 1) zk += zk; + else if (nz == 2) zk *= 4.0L; + else if (nz == 3) zk *= 8.0L; +/* + * order t1, t2, t3, t4 according to their size + */ + if (t2 >= fabsl(t3)) { + if (fabsl(t3) < fabsl(t4)) { + wh = t3; t3 = t4; t4 = wh; + } + } else { + wh = t2; t2 = t3; t3 = wh; + } +/* + * higher precision simulation: x * x + y * y = t1 + t2 + t3 + t4 + * = zk(7 bits) + zh(24 bits) + *er(tail) and call k_log_NKz + */ + tk = t1 - zk; + zh = ((tk + t2) + t3) + t4; + +/* split zh into correctly rounded half */ +#if defined(__x86) + ((unsigned *)&zh)[0] = 0; +#else + ly = ((unsigned *)&zh)[2]; + j = ((ly >> 24) + 1) >> 1; + ((unsigned *)&zh)[2] = (j << 25); + lx = ((unsigned *)&zh)[1]; + ly = lx + (j >> 7); + ((unsigned *)&zh)[1] = ly; + ((unsigned *)&zh)[0] += (ly == 0 && lx != 0); + ((unsigned *)&zh)[3] = 0; +#endif + + w = fabsl(zh); + if (w >= fabsl(t2)) +{ + *er = (((tk - zh) + t2) + t3) + t4; +} + + else { + + if (n == 0) { + wh = half * zk; + wh = (t1 - wh) - (wh - t2); + } else + wh = tk + t2; + if (w >= fabsl(t3)) + *er = ((wh - zh) + t3) + t4; + else { + z = t3; + t3 += t4; + t4 -= t3 - z; + if (w >= fabsl(t3)) + *er = ((wh - zh) + t3) + t4; + else + *er = ((wh + t3) - zh) + t4; + } + } + if (nz == 3) { + zh *= 0.125L; *er *= 0.125L; + } else if (nz == 2) { + zh *= 0.25L; *er *= 0.25L; + } else if (nz == 1) { + zh *= half; *er *= half; + } + nz += nx + nx; + w = half * k_log_NKzl(nz, k, zh, er); + *er *= half; + } + return (w); +} |