static double fp_add(double a, double b, double *lowres)
{
/* Result is the high part of a+b, with the low part assigned to *lowres */
double absa, absb;
if (a >= 0.0) absa = a; else absa = -a;
if (b >= 0.0) absb = b; else absb = -b;
if (absa < absb)
{ double t = a; a = b; b = t;
}
/* Now a is the larger (in absolute value) of the two numbers */
if (absb > absa * _two_minus_25)
{ double al = 0.0, bl = 0.0;
/*
* If the exponent difference beweeen a and b is no more than 25 then
* I can add the top part (20 or 24 bits) of a to the top part of b
* without going beyond the 52 or 56 bits that a full mantissa can hold.
*/
_fp_normalize(a, al);
_fp_normalize(b, bl);
a = a + b; /* No rounding needed here */
b = al + bl;
if (a == 0.0)
{ a = b;
b = 0.0;
}
}
/*
* The above step leaves b small wrt the value in a (unless a+b led
* to substantial cancellation of leading digits), but leaves the high
* part a with bits everywhere. Force low part of a to zero.
*/
{ double al = 0.0;
_fp_normalize(a, al);
b = b + al;
}
if (a >= 0.0) absa = a; else absa = -a;
if (b >= 0.0) absb = b; else absb = -b;
if (absb > absa * _two_minus_25)
/*
* If on input a is close to -b, then a+b is close to zero. In this
* case the exponents of a abd b matched, and so earlier calculations
* have all been done exactly. Go around again to split residue into
* high and low parts.
*/
{ double al = 0.0, bl = 0.0;
_fp_normalize(b, bl);
a = a + b;
_fp_normalize(a, al);
b = bl + al;
}
*lowres = b;
return a;
}
void
_big_binary_to_unpacked(_big_float *pb, unpacked *pu)
{
/* Convert a binary big_float to a binary_unpacked. */
int ib, iu;
#ifdef DEBUG
assert(pb->bsignificand[pb->blength - 1] != 0); /* Assert pb is
* normalized. */
#endif
iu = 0;
for (ib = pb->blength - 1; ((ib - 1) >= 0) && (iu < UNPACKED_SIZE); ib -= 2) {
pu->significand[iu++] = pb->bsignificand[ib] << 16 | pb->bsignificand[ib - 1];
}
if (iu < UNPACKED_SIZE) { /* The big float fits in the unpacked
* with no rounding. */
if (ib == 0)
pu->significand[iu++] = pb->bsignificand[ib] << 16;
for (; iu < UNPACKED_SIZE; iu++)
pu->significand[iu] = 0;
} else { /* The big float is too big; chop, stick, and
* normalize. */
while (pb->bsignificand[ib] == 0)
ib--;
if (ib >= 0)
pu->significand[UNPACKED_SIZE - 1] |= 1; /* Stick lsb if nonzero
* found. */
}
pu->exponent = 16 * pb->blength + pb->bexponent - 1;
_fp_normalize(pu);
#ifdef DEBUG
printf(" _big_binary_to_unpacked \n");
_display_unpacked(pu);
#endif
}
Complex MS_CDECL Cpow(Complex z1, Complex z2)
{
double a = z1.real, b = z1.imag,
c = z2.real, d = z2.imag;
int k, m, n;
double scale;
double logrh, logrl, thetah, thetal;
double r, i, rh, rl, ih, il, clow, dlow, q;
double cw, sw, cost, sint;
if (b == 0.0 && d == 0.0 && a >= 0.0)/* Simple case if both args are real */
{ z1.real = pow(a, c);
z1.imag = 0.0;
return z1;
}
/*
* Start by scaling z1 by dividing out a power of 2 so that |z1| is
* fairly close to 1
*/
if (a == 0.0)
{ if (b == 0.0) return z1; /* 0.0**anything is really an error */
/* The exact values returned by frexp do not matter here */
(void)frexp(b, &k);
}
else
{ (void)frexp(a, &k);
if (b != 0.0)
{ int n;
(void)frexp(b, &n);
if (n > k) k = n;
}
}
scale = ldexp(1.0, k);
a /= scale;
b /= scale;
/*
* The idea next is to express z1 as r*exp(i theta), then z1**z2
* is exp(z2*log(z1)) and the exponent simplifies to
* (c*log r - d*theta) + i(c theta + d log r).
* Note r = scale*sqrt(a*a + b*b) now.
* The argument for exp() must be computed to noticably more than
* regular precision, since otherwise exp() greatly magnifies the
* error in the real part (if it is large and positive) and range
* reduction in the imaginary part can equally lead to accuracy
* problems. Neither c nor d can usefully be anywhere near the
* extreme range of floating point values, so I will not even try
* to scale them, thus I will end up happy(ish) if I can compute
* atan2(b, a) and log(|z1|) in one-and-a-half precision form.
* It would be best to compute theta in units of pi/4 rather than in
* raidians, since then the case of z^n (integer n) with arg(z) an
* exact multiple of pi/4 would work out better. However at present I
* just hope that the 1.5-precision working is good enough.
*/
extended_atan2(b, a, &thetah, &thetal);
extended_log(k, a, b, &logrh, &logrl);
/* Normalise all numbers */
clow = 0.0;
dlow = 0.0;
_fp_normalize(c, clow);
_fp_normalize(d, dlow);
/* (rh, rl) = c*logr - d*theta; */
rh = c*logrh - d*thetah; /* No rounding in this computation */
rl = c*logrl + clow*(logrh + logrl) - d*thetal - dlow*(thetah + thetal);
/* (ih, il) = c*theta + d*logr; */
ih = c*thetah + d*logrh; /* No rounding in this computation */
il = c*thetal + clow*(thetah + thetal) + d*logrl + dlow*(logrh + logrl);
/*
* Now it remains to take the exponential of the extended precision
* value in ((rh, rl), (ih, il)).
* Range reduce the real part by multiples of log(2), and the imaginary
* part by multiples of pi/2.
*/
rh = fp_add(rh, rl, &rl); /* renormalise */
r = rh + rl; /* Approximate value */
#define _recip_log_2 1.4426950408889634074
q = r * _recip_log_2;
m = (q < 0.0) ? (int)(q - 0.5) : (int)(q + 0.5);
q = (double)m;
#undef _recip_log_2
/*
* log 2 = 11629080/2^24 - 0.000 00000 19046 54299 95776 78785
* to reasonable accuracy. It is vital that the exact part be
* read in as a number with lots of low zero bits, so when it gets
* multiplied by the integer q there is NO rounding needed.
*/
#define _exact_part_log2 0.693147182464599609375
#define _approx_part_log2 (-1.9046542999577678785418e-9)
rh = rh - q*_exact_part_log2;
rl = rl - q*_approx_part_log2;
#undef _exact_part_log2
#undef _approx_part_log2
r = exp(rh + rl); /* This should now be accurate enough */
ih = fp_add(ih, il, &il);
i = ih + il; /* Approximate value */
#define _recip_pi_by_2 0.6366197723675813431
q = i * _recip_pi_by_2;
n = (q < 0.0) ? (int)(q - 0.5) : (int)(q + 0.5);
q = (double)n;
/*
* pi/2 = 105414357/2^26 + 0.000 00000 09920 93579 68054 04416 39751
* to reasonable accuracy. It is vital that the exact part be
* read in as a number with lots of low zero bits, so when it gets
* multiplied by the integer q there is NO rounding needed.
*/
#define _exact_part_pi2 1.57079632580280303955078125
#define _approx_part_pi2 9.92093579680540441639751e-10
ih = ih - q*_exact_part_pi2;
il = il - q*_approx_part_pi2;
#undef _recip_pi_by_2
#undef _exact_part_pi2
#undef _approx_part_pi2
i = ih + il; /* Now accurate enough */
/*
* Having done super-careful range reduction I can call the regular
* sin/cos routines here. If sin/cos could both be computed together
* that could speed things up a little bit, but by this stage they have
* not much in common.
*/
cw = cos(i);
sw = sin(i);
switch (n & 3) /* quadrant control */
{
default:
case 0: cost = cw; sint = sw; break;
case 1: cost = -sw; sint = cw; break;
case 2: cost = -cw; sint = -sw; break;
case 3: cost = sw; sint = -cw; break;
}
/*
* Now, at long last, I can assemble the results and return.
*/
z1.real = ldexp(r*cost, m);
z1.imag = ldexp(r*sint, m);
return z1;
}
static void extended_log(int k, double a, double b,
double *logrh, double *logrl)
{
/*
* If we had exact arithmetic this procedure could be:
* k*log(2) + 0.5*log(a^2 + b^2)
*/
double al = 0.0, bl = 0.0, all = 0.0, bll = 0.0, c, ch, cl, cll;
double w, q, qh, ql, rh, rl;
int n;
/*
* First (a^2 + b^2) is calculated, using extra precision.
* Because any rounding at this stage can lead to bad errors in
* the power that I eventually want to compute, I use 3-word
* arithmetic here, and with the version of _fp_normalize given
* above and IEEE or IBM370 arithmetic this part of the
* computation is exact.
*/
_fp_normalize(a, al); _fp_normalize(al, all);
_fp_normalize(b, bl); _fp_normalize(bl, bll);
ch = a*a + b*b;
cl = 2.0*(a*al + b*bl);
cll = (al*al + bl*bl) +
all*(2.0*(a + al) + all) +
bll*(2.0*(b + bl) + bll);
_fp_normalize(ch, cl);
_fp_normalize(cl, cll);
c = ch + (cl + cll); /* single precision approximation */
/*
* At this stage the scaling of the input value will mean that we
* have 0.25 <= c <= 2.0
*
* Now rewrite things as
* (2*k + n)*log(s) + 0.5*log((a^2 + b^2)/2^n))
* where s = sqrt(2)
* and where the arg to the log is in sqrt(0.5), sqrt(2)
*/
#define _sqrt_half 0.70710678118654752440
#define _sqrt_two 1.41421356237309504880
k = 2*k;
while (c < _sqrt_half)
{ k -= 1;
ch *= 2.0;
cl *= 2.0;
cll *= 2.0;
c *= 2.0;
}
while (c > _sqrt_two)
{ k += 1;
ch *= 0.5;
cl *= 0.5;
cll *= 0.5;
c *= 0.5;
}
#undef _sqrt_half
#undef _sqrt_two
n = (int)(16.0/c + 0.5);
w = (double)n / 16.0;
ch *= w;
cl *= w;
cll *= w; /* Now |c-1| < 0.04317 */
ch = (ch - 0.5) - 0.5;
ch = fp_add(ch, cl, &cl);
cl = cl + cll;
/*
* (ch, cl) is now the reduced argument ready for calculating log(1+c),
* and now that the reduction is over I can drop back to the use of just
* two doubleprecision values to represent c.
*/
c = ch + cl;
qh = c / (2.0 + c);
ql = 0.0;
_fp_normalize(qh, ql);
ql = ((ch - qh*(2.0 + ch)) + cl - qh*cl) / (2.0 + c);
/* (qh, ql) is now c/(2.0 + c) */
rh = qh; /* 18 bits bigger than low part will end up */
q = qh + ql;
w = q*q;
rl = ql + q*w*(0.33333333333333333333 +
w*(0.20000000000000000000 +
w*(0.14285714285714285714 +
w*(0.11111111111111111111 +
w*(0.09090909090909090909)))));
/*
* (rh, rl) is now atan(c) correct to double precision plus about 18 bits.
*/
{ double temp;
static struct { double h; double l; } _log_table[] = {
/*
* The following values are (in extra precision) -log(n/16)/2 for n
* in the range 11 to 23 (i.e. roughly over sqrt(2)/2 to sqrt(2))
*/
{ 0.1873466968536376953125, 2.786706765149099245e-8 },
{ 0.1438410282135009765625, 0.801238948715710950e-8 },
{ 0.103819668292999267578125, 1.409612298322959552e-8 },
{ 0.066765725612640380859375, -2.930037906928620319e-8 },
{ 0.0322692394256591796875, 2.114312640614896196e-8 },
{ 0.0, 0.0 },
{ -0.0303122997283935546875, -1.117982386660280307e-8 },
{ -0.0588915348052978515625, 1.697710612429310295e-8 },
{ -0.08592510223388671875, -2.622944289242004947e-8 },
{ -0.111571788787841796875, 1.313073691899185245e-8 },
{ -0.135966837406158447265625, -2.033566243215020975e-8 },
{ -0.159226894378662109375, 2.881939480146987639e-8 },
{ -0.18145275115966796875, 0.431498374218108783e-8 }};
rh = fp_add(rh, _log_table[n-11].h, &temp);
rl = temp + _log_table[n-11].l + rl;
}
#define _exact_part_logroot2 0.3465735912322998046875
#define _approx_part_logroot2 (-9.5232714997888393927e-10)
/* Multiply this by k and add it in */
{ double temp, kd = (double)k;
rh = fp_add(rh, kd*_exact_part_logroot2, &temp);
rl = rl + temp + kd*_approx_part_logroot2;
}
#undef _exact_part_logroot2
#undef _approx_part_logroot2
*logrh = rh;
*logrl = rl;
return;
}
static void extended_atan2(double b, double a, double *thetah, double *thetal)
{
int octant;
double rh, rl, thh, thl;
/*
* First reduce the argument to the first octant (i.e. a, b both +ve,
* and b <= a).
*/
if (b < 0.0)
{ octant = 4;
a = -a;
b = -b;
}
else octant = 0;
if (a < 0.0)
{ double t = a;
octant += 2;
a = b;
b = -t;
}
if (b > a)
{ double t = a;
octant += 1;
a = b;
b = t;
}
{ static struct { double h; double l;} _atan[] = {
/*
* The table here gives atan(n/16) in 1.5-precision for n=0..16
* Note that all the magic numbers used in this file were calculated
* using the REDUCE bigfloat package, and all the 'exact' parts have
* a denominator of at worst 2^26 and so are expected to have lots
* of trailing zero bits in their floating point representation.
*/
{ 0.0, 0.0 },
{ 0.06241881847381591796875, -0.84778585694947708870e-8 },
{ 0.124355018138885498046875, -2.35921240630155201508e-8 },
{ 0.185347974300384521484375, -2.43046897565983490387e-8 },
{ 0.2449786663055419921875, -0.31786778380154175187e-8 },
{ 0.302884876728057861328125, -0.83530864557675689054e-8 },
{ 0.358770668506622314453125, 0.17639499059427950639e-8 },
{ 0.412410438060760498046875, 0.35366268088529162896e-8 },
{ 0.4636476039886474609375, 0.50121586552767562314e-8 },
{ 0.512389481067657470703125, -2.07569197640365239794e-8 },
{ 0.558599293231964111328125, 2.21115983246433832164e-8 },
{ 0.602287352085113525390625, -0.59501493437085023057e-8 },
{ 0.643501102924346923828125, 0.58689374629746842287e-8 },
{ 0.6823165416717529296875, 1.32029951485689299817e-8 },
{ 0.71882998943328857421875, 1.01883359311982641515e-8 },
{ 0.75315129756927490234375, -1.66070805128190106297e-8 },
{ 0.785398185253143310546875, -2.18556950009312141541e-8 }
};
int k = (int)(16.0*(b/a + 0.03125)); /* 0 to 16 */
double kd = (double)k/16.0;
double ah = a, al = 0.0,
bh = b, bl = 0.0,
ch, cl, q, q2;
_fp_normalize(ah, al);
_fp_normalize(bh, bl);
ch = bh - ah*kd; cl = bl - al*kd;
ah = ah + bh*kd; al = al + bl*kd;
bh = ch; bl = cl;
/* Now |(a/b)| <= 1/32 */
ah = fp_add(ah, al, &al); /* Re-normalise */
bh = fp_add(bh, bl, &bl);
/* Compute approximation to b/a */
rh = (bh + bl)/(ah + al); rl = 0.0;
_fp_normalize(rh, rl);
bh -= ah*rh; bl -= al*rh;
rl = (bh + bl)/(ah + al); /* Quotient now formed */
/*
* Now it is necessary to compute atan(q) to one-and-a-half precision.
* Since |q| < 1/32 I will leave just q as the high order word of
* the result and compute atan(q)-q as a single precision value. This
* gives about 16 bits accuracy beyond regular single precision work.
*/
q = rh + rl;
q2 = q*q;
/* The expansion the follows could be done better using a minimax poly */
rl -= q*q2*(0.33333333333333333333 -
q2*(0.20000000000000000000 -
q2*(0.14285714285714285714 -
q2*(0.11111111111111111111 -
q2* 0.09090909090909090909))));
/* OK - now (rh, rl) is atan(reduced b/a). Need to add on atan(kd) */
rh += _atan[k].h;
rl += _atan[k].l;
}
/*
* The following constants give high precision versions of pi and pi/2,
* and the high partwords (p2h and pih) have lots of low order zero bits
* in their binary representation. Expect (=require) that the arithmetic
* that computes thh is done without introduced rounding error.
*/
#define _p2h 1.57079632580280303955078125
#define _p2l 9.92093579680540441639751e-10
#define _pih 3.14159265160560607910156250
#define _pil 1.984187159361080883279502e-9
switch (octant)
{
default:
case 0: thh = rh; thl = rl; break;
case 1: thh = _p2h - rh; thl = _p2l - rl; break;
case 2: thh = _p2h + rh; thl = _p2l + rl; break;
case 3: thh = _pih - rh; thl = _pil - rl; break;
case 4: thh = -_pih + rh; thl = -_pil + rl; break;
case 5: thh = -_p2h - rh; thl = -_p2l - rl; break;
case 6: thh = -_p2h + rh; thl = -_p2l + rl; break;
case 7: thh = -rh; thl = -rl; break;
}
#undef _p2h
#undef _p2l
#undef _pih
#undef _pil
*thetah = fp_add(thh, thl, thetal);
}
