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; }