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;
}
Error float_out(
p_otokens tokens,
floatnum x,
int scale,
signed char base,
char outmode)
{
t_number_desc n;
_emptytokens(tokens);
/* do some sanity checks first */
if (!_validmode(outmode) || scale < 0 || !_isvalidbase(base))
return InvalidParam;
_clearnumber(&n);
if (float_iszero(x))
n.prefix.base = IO_BASE_ZERO;
else if (!float_isnan(x))
n.prefix.base = base;
if (!_isvalidbase(n.prefix.base))
/* NaN and 0 are handled here */
return desc2str(tokens, &n, 0);
n.prefix.sign = float_getsign(x);
float_abs(x);
switch (outmode)
{
case IO_MODE_FIXPOINT:
return _outfixp(tokens, x, &n, scale);
case IO_MODE_ENG:
return _outeng(tokens, x, &n, scale);
case IO_MODE_COMPLEMENT:
return _outcompl(tokens, x, &n, 0);
default:
return _outsci(tokens, x, &n, scale);
}
}
char
_doshift(
floatnum dest,
cfloatnum x,
cfloatnum shift,
char right)
{
int ishift;
t_longint lx;
if (float_isnan(shift))
return _seterror(dest, NoOperand);
if (!float_isinteger(shift))
return _seterror(dest, OutOfDomain);
if(!_cvtlogic(&lx, x))
return 0;
if (float_iszero(shift))
{
float_copy(dest, x, EXACT);
return 1;
}
ishift = float_asinteger(shift);
if (ishift == 0)
ishift = (3*LOGICRANGE) * float_getsign(shift);
if (!right)
ishift = -ishift;
if (ishift > 0)
_shr(&lx, ishift);
else
_shl(&lx, -ishift);
_logic2floatnum(dest, &lx);
return 1;
}
char
float_raisei(
floatnum power,
cfloatnum base,
int exponent,
int digits)
{
if (digits <= 0 || digits > maxdigits)
return _seterror(power, InvalidPrecision);
if (float_isnan(base))
return _seterror(power, NoOperand);
if (float_iszero(base))
{
if (exponent == 0)
return _seterror(power, OutOfDomain);
if (exponent < 0)
return _seterror(power, ZeroDivide);
return _setzero(power);
}
digits += 14;
if (digits > maxdigits)
digits = maxdigits;
float_copy(power, base, digits);
if (!_raisei(power, exponent, digits)
|| !float_isvalidexp(float_getexponent(power)))
{
if (float_getexponent(base) < 0)
return _seterror(power, Underflow);
return _seterror(power, Overflow);
}
return 1;
}
char
float_factorial(
floatnum x,
int digits)
{
if (!float_isnan(x))
float_add(x, x, &c1, digits);
return float_gamma(x, digits);
}
char
float_raise(
floatnum power,
cfloatnum base,
cfloatnum exponent,
int digits)
{
signed char sgn;
if (float_isnan(exponent) || float_isnan(base))
return _seterror(power, NoOperand);
if (digits <= 0 || digits > MATHPRECISION)
return _seterror(power, InvalidPrecision);
if (float_iszero(base))
{
switch(float_getsign(exponent))
{
case 0:
return _seterror(power, OutOfDomain);
case -1:
return _seterror(power, ZeroDivide);
}
return _setzero(power);
}
sgn = float_getsign(base);
if (sgn < 0)
{
if (!float_isinteger(exponent))
return _seterror(power, OutOfDomain);
if ((float_getdigit(exponent, float_getexponent(exponent)) & 1) == 0)
sgn = 1;
}
float_copy(power, base, digits+1);
float_abs(power);
if (!_raise(power, exponent, digits))
{
float_seterror(Overflow);
if (float_getexponent(base) * float_getsign(exponent) < 0)
float_seterror(Underflow);
return _setnan(power);
}
float_setsign(power, sgn);
return 1;
}
char
float_pochhammer(
floatnum x,
cfloatnum delta,
int digits)
{
if (!chckmathparam(x, digits))
return 0;
return float_isnan(delta)?
_seterror(x, NoOperand)
: _pochhammer(x, delta, digits);
}
static char
_cvtlogic(
t_longint* lx,
cfloatnum x)
{
if (float_isnan(x))
{
float_seterror(NoOperand);
return 0;
}
if (_floatnum2logic(lx, x))
return 1;
float_seterror(OutOfLogicRange);
return 0;
}
char
erfcsum(
floatnum x, /* should be the square of the parameter to erfc */
int digits)
{
int i, workprec;
floatstruct sum, smd;
floatnum Ei;
if (digits > erfcdigits)
{
/* cannot re-use last evaluation's intermediate results */
for (i = MAXERFCIDX; --i >= 0;)
/* clear all exp(-k*k*alpha*alpha) to indicate their absence */
float_free(&erfccoeff[i]);
/* current precision */
erfcdigits = digits;
/* create new alpha appropriate for the desired precision
This alpha need not be high precision, any alpha near the
one evaluated here would do */
float_muli(&erfcalpha, &cLn10, digits + 4, 3);
float_sqrt(&erfcalpha, 3);
float_div(&erfcalpha, &cPi, &erfcalpha, 3);
float_mul(&erfcalphasqr, &erfcalpha, &erfcalpha, EXACT);
/* the exp(-k*k*alpha*alpha) are later evaluated iteratively.
Initiate the iteration here */
float_copy(&erfct2, &erfcalphasqr, EXACT);
float_neg(&erfct2);
_exp(&erfct2, digits + 3); /* exp(-alpha*alpha) */
float_copy(erfccoeff, &erfct2, EXACT); /* start value */
float_mul(&erfct3, &erfct2, &erfct2, digits + 3); /* exp(-2*alpha*alpha) */
}
float_create(&sum);
float_create(&smd);
float_setzero(&sum);
for (i = 0; ++i < MAXERFCIDX;)
{
Ei = &erfccoeff[i-1];
if (float_isnan(Ei))
{
/* if exp(-i*i*alpha*alpha) is not available, evaluate it from
the coefficient of the last summand */
float_mul(&erfct2, &erfct2, &erfct3, workprec + 3);
float_mul(Ei, &erfct2, &erfccoeff[i-2], workprec + 3);
}
/* Ei finally decays rapidly. save some time by adjusting the
working precision */
workprec = digits + float_getexponent(Ei) + 1;
if (workprec <= 0)
break;
/* evaluate the summand exp(-i*i*alpha*alpha)/(i*i*alpha*alpha+x) */
float_muli(&smd, &erfcalphasqr, i*i, workprec);
float_add(&smd, x, &smd, workprec + 2);
float_div(&smd, Ei, &smd, workprec + 1);
/* add summand to the series */
float_add(&sum, &sum, &smd, digits + 3);
}
float_move(x, &sum);
float_free(&smd);
return 1;
}