static Error
_pack2frac(
floatnum x,
p_ext_seq_desc n,
int digits)
{
floatstruct tmp;
int exp;
Error result;
n->seq.digits -= n->seq.trailing0;
n->seq.trailing0 = 0;
switch(n->seq.base)
{
case IO_BASE_NAN:
float_setnan(x);
break;
case IO_BASE_ZERO:
float_setzero(x);
break;
default:
if ((result = _pack2int(x, n)) != Success)
return result;
float_create(&tmp);
float_setinteger(&tmp, n->seq.base);
_raiseposi(&tmp, &exp, n->seq.digits, digits+2);
float_div(x, x, &tmp, digits + 2);
float_setexponent(x, float_getexponent(x) - exp);
float_free(&tmp);
}
n->seq.digits += n->seq.trailing0;
return Success;
}
char
_gamma(
floatnum x,
int digits)
{
floatstruct tmp;
int infinity;
char result;
if (float_cmp(&cMinus20, x) > 0)
{
float_create(&tmp);
result = _lngamma_prim(x, &tmp, &infinity, digits)
&& infinity == 0
&& _exp(x, digits)
&& float_div(x, x, &tmp, digits + 1);
float_free(&tmp);
if (infinity != 0)
return _seterror(x, ZeroDivide);
if (!result)
float_setnan(x);
return result;
}
return _gammagtminus20(x, digits);
}
char
_lngamma(
floatnum x,
int digits)
{
floatstruct factor;
int infinity;
char result;
if (float_cmp(x, &c1) == 0 || float_cmp(x, &c2) == 0)
return _setzero(x);
float_create(&factor);
result = _lngamma_prim(x, &factor, &infinity, digits)
&& infinity == 0;
if (result)
{
float_abs(&factor);
_ln(&factor, digits + 1);
result = float_sub(x, x, &factor, digits+1);
}
float_free(&factor);
if (infinity != 0)
return _seterror(x, ZeroDivide);
if (!result)
float_setnan(x);
return result;
}
static Error
_packdec2int(
floatnum x,
p_ext_seq_desc n)
{
int ofs;
int exp;
int bufsz;
int i;
char buf[DECPRECISION];
float_setnan(x);
ofs = n->seq.leadingSignDigits;
exp = n->seq.trailing0;
bufsz = n->seq.digits - ofs - exp;
if (bufsz > DECPRECISION)
return IOBufferOverflow;
if (bufsz == 0)
float_setzero(x);
else
for (i = -1; ++i < bufsz;)
buf[i] = n->getdigit(ofs++, &n->seq) + '0';
float_setsignificand(x, NULL, buf, bufsz);
float_setexponent(x, exp + bufsz - 1);
return Success;
}
char
float_gamma(
floatnum x,
int digits)
{
signed char sign;
char result;
if (!chckmathparam(x, digits))
return 0;
sign = float_getsign(x);
if (float_isinteger(x))
{
if (sign <= 0)
return _seterror(x, ZeroDivide);
result = _gammaint(x, digits);
}
else if (float_getlength(x) - float_getexponent(x) == 2
&& float_getdigit(x, float_getlength(x) - 1) == 5)
result = _gamma0_5(x, digits);
else
result = _gamma(x, digits);
if (!result)
{
if (sign < 0)
float_seterror(Underflow);
else
float_seterror(Overflow);
float_setnan(x);
}
return result;
}
char
binetasymptotic(floatnum x,
int digits)
{
floatstruct recsqr;
floatstruct sum;
floatstruct smd;
floatstruct pwr;
int i, workprec;
if (float_getexponent(x) >= digits)
{
/* if x is very big, ln(gamma(x)) is
dominated by x*ln x and the Binet function
does not contribute anything substantial to
the final result */
float_setzero(x);
return 1;
}
float_create(&recsqr);
float_create(&sum);
float_create(&smd);
float_create(&pwr);
float_copy(&pwr, &c1, EXACT);
float_setzero(&sum);
float_div(&smd, &c1, &c12, digits+1);
workprec = digits - 2*float_getexponent(x)+3;
i = 1;
if (workprec > 0)
{
float_mul(&recsqr, x, x, workprec);
float_reciprocal(&recsqr, workprec);
while (float_getexponent(&smd) > -digits-1
&& ++i <= MAXBERNOULLIIDX)
{
workprec = digits + float_getexponent(&smd) + 3;
float_add(&sum, &sum, &smd, digits+1);
float_mul(&pwr, &recsqr, &pwr, workprec);
float_muli(&smd, &cBernoulliDen[i-1], 2*i*(2*i-1), workprec);
float_div(&smd, &pwr, &smd, workprec);
float_mul(&smd, &smd, &cBernoulliNum[i-1], workprec);
}
}
else
/* sum reduces to the first summand*/
float_move(&sum, &smd);
if (i > MAXBERNOULLIIDX)
/* x was not big enough for the asymptotic
series to converge sufficiently */
float_setnan(x);
else
float_div(x, &sum, x, digits);
float_free(&pwr);
float_free(&smd);
float_free(&sum);
float_free(&recsqr);
return i <= MAXBERNOULLIIDX;
}
Error
pack2floatnum(
floatnum x,
p_number_desc n)
{
floatstruct tmp;
int digits;
int saveerr;
int saverange;
Error result;
signed char base;
if ((result = _pack2int(x, &n->intpart)) != Success)
return result;
if (float_isnan(x))
return Success;
saveerr = float_geterror();
saverange = float_setrange(MAXEXP);
float_create(&tmp);
float_move(&tmp, x);
float_setzero(x);
digits = DECPRECISION - float_getexponent(&tmp);
if (digits <= 0
|| (result = _pack2frac(x, &n->fracpart, digits)) == Success)
float_add(x, x, &tmp, DECPRECISION);
if (result != Success)
return result;
if ((!float_getlength(x)) == 0) /* no zero, no NaN? */
{
base = n->prefix.base;
float_setinteger(&tmp, base);
if (n->exp >= 0)
{
_raiseposi_(&tmp, n->exp, DECPRECISION + 2);
float_mul(x, x, &tmp, DECPRECISION + 2);
}
else
{
_raiseposi_(&tmp, -n->exp, DECPRECISION + 2);
float_div(x, x, &tmp, DECPRECISION + 2);
}
}
float_free(&tmp);
float_setsign(x, n->prefix.sign == IO_SIGN_COMPLEMENT? -1 : n->prefix.sign);
float_geterror();
float_seterror(saveerr);
float_setrange(saverange);
if (!float_isvalidexp(float_getexponent(x)))
float_setnan(x);
return float_isnan(x)? IOExpOverflow : Success;
}
static Error
_packbin2int(
floatnum x,
p_ext_seq_desc n)
{
t_longint l;
Error result;
float_setnan(x);
if ((result = _pack2longint(&l, n)) != Success)
return result;
_longint2floatnum(x, &l);
return Success;
}
Error
float_in(
floatnum x,
p_itokens tokens)
{
t_number_desc n;
Error result;
if ((result = str2desc(&n, tokens)) == Success)
result = pack2floatnum(x, &n);
if (result != Success)
{
_seterror(x, BadLiteral);
float_setnan(x);
}
return result;
}
static Error
_pack2int(
floatnum x,
p_ext_seq_desc n)
{
switch(n->seq.base)
{
case IO_BASE_NAN:
float_setnan(x);
break;
case IO_BASE_ZERO:
float_setzero(x);
break;
case 10:
return _packdec2int(x, n);
default:
return _packbin2int(x, n);
}
return Success;
}
char
_gammagtminus20(
floatnum x,
int digits)
{
floatstruct factor;
int ofs;
char result;
float_create(&factor);
ofs = _ofs(x, digits+1);
float_copy(&factor, x, digits+1);
_pochhammer_su(&factor, ofs, digits);
float_addi(x, x, ofs, digits+2);
result = _lngammabigx(x, digits)
&& _exp(x, digits)
&& float_div(x, x, &factor, digits+1);
float_free(&factor);
if (!result)
float_setnan(x);
return result;
}
static char
_pochhammer_g(
floatnum x,
cfloatnum n,
int digits)
{
/* this generalizes the rising Pochhammer symbol using the
formula pochhammer(x,n) = Gamma(x+1)/Gamma(x-n+1) */
floatstruct tmp, factor1, factor2;
int inf1, inf2;
char result;
float_create(&tmp);
float_create(&factor1);
float_create(&factor2);
inf2 = 0;
float_add(&tmp, x, n, digits+1);
result = _lngamma_prim(x, &factor1, &inf1, digits)
&& _lngamma_prim(&tmp, &factor2, &inf2, digits)
&& (inf2 -= inf1) <= 0;
if (inf2 > 0)
float_seterror(ZeroDivide);
if (result && inf2 < 0)
float_setzero(x);
if (result && inf2 == 0)
result = float_div(&factor1, &factor1, &factor2, digits+1)
&& float_sub(x, &tmp, x, digits+1)
&& _exp(x, digits)
&& float_mul(x, x, &factor1, digits+1);
float_free(&tmp);
float_free(&factor2);
float_free(&factor1);
if (!result)
float_setnan(x);
return result;
}
