static void
decimal_to_decnumber (const REAL_VALUE_TYPE *r, decNumber *dn)
{
decContext set;
decContextDefault (&set, DEC_INIT_DECIMAL128);
set.traps = 0;
switch (r->cl)
{
case rvc_zero:
decNumberZero (dn);
break;
case rvc_inf:
decNumberFromString (dn, (char *)"Infinity", &set);
break;
case rvc_nan:
if (r->signalling)
decNumberFromString (dn, (char *)"snan", &set);
else
decNumberFromString (dn, (char *)"nan", &set);
break;
case rvc_normal:
gcc_assert (r->decimal);
decimal128ToNumber ((decimal128 *) r->sig, dn);
break;
default:
gcc_unreachable ();
}
/* Fix up sign bit. */
if (r->sign != decNumberIsNegative (dn))
dn->bits ^= DECNEG;
}
decNumber *decNumberAGM(decNumber *res, const decNumber *x, const decNumber *y) {
int n;
decNumber a, g, t, u;
if (decNumberIsNegative(x) || decNumberIsNegative(y))
goto nan;
if (decNumberIsSpecial(x) || decNumberIsSpecial(y)) {
if (decNumberIsNaN(x) || decNumberIsNaN(y))
goto nan;
if (dn_eq0(x) || dn_eq0(y))
goto nan;
return set_inf(res);
}
decNumberCopy(&a, x);
decNumberCopy(&g, y);
for (n=0; n<1000; n++) {
if (relative_error(&a, &g, &const_1e_32))
return decNumberCopy(res, &a);
dn_add(&t, &a, &g);
dn_div2(&u, &t);
dn_multiply(&t, &a, &g);
if (dn_eq0(&t))
return decNumberZero(res);
dn_sqrt(&g, &t);
decNumberCopy(&a, &u);
}
nan: return set_NaN(res);
}
void zetadk(decNumber *dk, int n, int k, decContext *ctx) {
int i;
decNumber t, r, s, v, sum, const_4;
int_to_dn(&const_4, 4, ctx);
decNumberZero(&sum);
for (i=0; i<=k; i++) {
int_to_dn(&t, n+i-1, ctx);
decNumberFactorial(&s, &t, ctx);
int_to_dn(&t, i, ctx);
decNumberPower(&r, &const_4, &t, ctx);
decNumberMultiply(&v, &s, &r, ctx);
int_to_dn(&t, n-i, ctx);
decNumberFactorial(&s, &t, ctx);
int_to_dn(&t, 2*i, ctx);
decNumberFactorial(&r, &t, ctx);
decNumberMultiply(&t, &r, &s, ctx);
decNumberDivide(&r, &v, &t, ctx);
decNumberAdd(&sum, &sum, &r, ctx);
}
int_to_dn(&t, n, ctx);
#if 1
// Don't bother rounding to int, the conversion in compile_consts
// will do this if required due to the extra precision being carries.
decNumberMultiply(dk, &t, &sum, ctx);
#else
// We can round this to integers this way....
decNumberMultiply(&s, &t, &sum, ctx);
decNumberToIntegralValue(dk, &s, ctx);
#endif
}
DecimalDecNumber::DecimalDecNumber()
{
decContextDefault(&m_context, DEC_INIT_BASE); // initialize
m_context.traps = 0; // no traps, thank you
m_context.digits = DECNUMDIGITS; // set precision
decNumberZero(&m_value);
}
/* Perform an in-situ LU decomposition of a user's matrix.
* Return the pivot descriptor.
*/
decNumber *matrix_lu_decomp(decNumber *r, const decNumber *m) {
unsigned char pivots[MAX_SQUARE];
int i, sign, n;
decNumber t, u;
decimal128 mat[MAX_SQUARE*MAX_SQUARE];
decimal64 *base;
n = matrix_lu_check(m, mat, &base);
if (n == 0)
return NULL;
sign = LU_decomposition(mat, pivots, n);
if (sign == 0) {
err(ERR_SINGULAR);
return NULL;
}
/* Build the pivot number */
decNumberZero(r);
for (i=0; i<n; i++) {
int_to_dn(&t, pivots[i]);
dn_mulpow10(&u, r, 1);
dn_add(r, &u, &t);
}
/* Copy the result back over the matrix */
for (i=0; i<n*n; i++) {
packed_from_packed128(base+i, mat+i);
}
return r;
}
// Matrix multiply c = a * b, c can be a or b or overlap either
decNumber *matrix_multiply(decNumber *r, const decNumber *a, const decNumber *b, const decNumber *c) {
int arows, acols, brows, bcols;
decNumber sum, s, t, u;
int creg;
int i, j, k;
decimal64 result[MAX_DIMENSION];
decimal64 *rp = result;
decimal64 *abase = matrix_decomp(a, &arows, &acols);
decimal64 *bbase = matrix_decomp(b, &brows, &bcols);
if (abase == NULL || bbase == NULL)
return NULL;
if (acols != brows) {
err(ERR_MATRIX_DIM);
return NULL;
}
creg = dn_to_int(c);
if (matrix_descriptor(r, creg, arows, bcols) == 0)
return NULL;
busy();
for (i=0; i<arows; i++)
for (j=0; j<bcols; j++) {
decNumberZero(&sum);
for (k=0; k<acols; k++) {
matrix_get(&s, abase, i, k, acols);
matrix_get(&t, bbase, k, j, bcols);
dn_multiply(&u, &s, &t);
dn_add(&sum, &sum, &u);
}
packed_from_number(rp++, &sum);
}
xcopy(get_reg_n(creg), result, sizeof(decimal64) * arows * bcols);
return r;
}
static void
decimal_to_decnumber (const REAL_VALUE_TYPE *r, decNumber *dn)
{
decContext set;
decContextDefault (&set, DEC_INIT_DECIMAL128);
set.traps = 0;
switch (r->cl)
{
case rvc_zero:
decNumberZero (dn);
break;
case rvc_inf:
decNumberFromString (dn, "Infinity", &set);
break;
case rvc_nan:
if (r->signalling)
decNumberFromString (dn, "snan", &set);
else
decNumberFromString (dn, "nan", &set);
break;
case rvc_normal:
if (!r->decimal)
{
/* dconst{1,2,m1,half} are used in various places in
the middle-end and optimizers, allow them here
as an exception by converting them to decimal. */
if (memcmp (r, &dconst1, sizeof (*r)) == 0)
{
decNumberFromString (dn, "1", &set);
break;
}
if (memcmp (r, &dconst2, sizeof (*r)) == 0)
{
decNumberFromString (dn, "2", &set);
break;
}
if (memcmp (r, &dconstm1, sizeof (*r)) == 0)
{
decNumberFromString (dn, "-1", &set);
break;
}
if (memcmp (r, &dconsthalf, sizeof (*r)) == 0)
{
decNumberFromString (dn, "0.5", &set);
break;
}
gcc_unreachable ();
}
decimal128ToNumber ((const decimal128 *) r->sig, dn);
break;
default:
gcc_unreachable ();
}
/* Fix up sign bit. */
if (r->sign != decNumberIsNegative (dn))
dn->bits ^= DECNEG;
}
/* ------------------------------------------------------------------ */
decNumber *
decimal128ToNumber (const decimal128 *d128, decNumber *dn)
{
uInt uiwork;
uInt sourhi;
uInt sourmh;
uInt sourml;
uInt sourlo;
Int shift;
/* load source from storage; this is endian */
sourhi = UBTOUIBW(d128->bytes );
sourmh = UBTOUIBW(d128->bytes+4);
sourml = UBTOUIBW(d128->bytes+8);
sourlo = UBTOUIBW(d128->bytes+12);
decNumberZero(dn);
if (sourhi & BID_SIGN_MASK)
dn->bits |= DECNEG;
/* Infinities and NaN are encoded just like DPD:
s 11 110 0.... 0 00 ... 00 -> canonical infinites
s 11 110 any any -> infinites
s 11 1110 0 .... 0 payloads -> canonical qNaN
s 11 1110 any any -> qNaN
s 11 1111 0 .... 0 payloads -> canonical sNaN
s 11 1111 any any -> sNaN */
if ((sourhi & BID_SNAN_ENC_MASK) == BID_SNAN_ENC_MASK)
dn->bits |= DECSNAN;
else if ((sourhi & BID_NAN_ENC_MASK) == BID_NAN_ENC_MASK)
dn->bits |= DECNAN;
else if ((sourhi & BID_INF_ENC_MASK) == BID_INF_ENC_MASK)
{
dn->bits |= DECINF;
return dn; /* no coefficient needed */
}
else
{
/* The exponent is decoded as:
E = binary decode (bL−2 bL−3 · · · bL−w−1 ) if (bL−2 bL−3 ) != 11
\_ decimal128 (w=14) -> bL-2 bL-3 ... bL-11
binary decode (bL−4 bL−5 · · · bL−w−3 ) if (bL−2 bL−3 ) == 11
\_ decimal128 (w=14) -> bl-4 bl-5 ... bl-13
The 0x60000000 is binary mask to check if bL-2, bL-3 are set. */
if ((sourhi & BID_EXPONENT_ENC_MASK) == BID_EXPONENT_ENC_MASK)
shift = BID_EXP_SHIFT_LARGE128;
else
shift = BID_EXP_SHIFT_SMALL128;
dn->exponent = ((sourhi >> shift) & BID_EXP_MASK128) - DECIMAL128_Bias;
}
decDigitsFromBID(dn, sourhi, sourmh, sourml, sourlo);
/*decNumberShow (dn);*/
return dn;
}
/* ------------------------------------------------------------------ */
decNumber * decPackedToNumber(const uByte *bcd, Int length,
const Int *scale, decNumber *dn) {
const uByte *last=bcd+length-1; // -> last byte
const uByte *first; // -> first non-zero byte
uInt nib; // work nibble
Unit *up=dn->lsu; // output pointer
Int digits; // digits count
Int cut=0; // phase of output
decNumberZero(dn); // default result
last=&bcd[length-1];
nib=*last & 0x0f; // get the sign
if (nib==DECPMINUS || nib==DECPMINUSALT) dn->bits=DECNEG;
else if (nib<=9) return NULL; // not a sign nibble
// skip leading zero bytes [final byte is always non-zero, due to sign]
for (first=bcd; *first==0;) first++;
digits=(last-first)*2+1; // calculate digits ..
if ((*first & 0xf0)==0) digits--; // adjust for leading zero nibble
if (digits!=0) dn->digits=digits; // count of actual digits [if 0,
// leave as 1]
// check the adjusted exponent; note that scale could be unbounded
dn->exponent=-*scale; // set the exponent
if (*scale>=0) { // usual case
if ((dn->digits-*scale-1)<-DECNUMMAXE) { // underflow
decNumberZero(dn);
return NULL;}
}
else { // -ve scale; +ve exponent
// need to be careful to avoid wrap, here, also BADINT case
if ((*scale<-DECNUMMAXE) // overflow even without digits
|| ((dn->digits-*scale-1)>DECNUMMAXE)) { // overflow
decNumberZero(dn);
return NULL;}
}
if (digits==0) return dn; // result was zero
// copy the digits to the number's units, starting at the lsu
// [unrolled]
for (;;) { // forever
// left nibble first
nib=(unsigned)(*last & 0xf0)>>4;
// got a digit, in nib
if (nib>9) {decNumberZero(dn); return NULL;}
if (cut==0) *up=(Unit)nib;
else *up=(Unit)(*up+nib*DECPOWERS[cut]);
digits--;
if (digits==0) break; // got them all
cut++;
if (cut==DECDPUN) {
up++;
cut=0;
}
last--; // ready for next
nib=*last & 0x0f; // get right nibble
if (nib>9) {decNumberZero(dn); return NULL;}
// got a digit, in nib
if (cut==0) *up=(Unit)nib;
else *up=(Unit)(*up+nib*DECPOWERS[cut]);
digits--;
if (digits==0) break; // got them all
cut++;
if (cut==DECDPUN) {
up++;
cut=0;
}
} // forever
return dn;
} // decPackedToNumber
/* Smart CDF helper routine that return three values */
void cdf_Q_helper(enum nilop op) {
decNumber a, b, t, u, x2, d, absx, x;
int i;
getX(&x);
dn_abs(&absx, &x);
if (dn_lt(&absx, &const_2_326)) {
decNumberSquare(&x2, &absx);
decNumberCopy(&t, &absx);
decNumberCopy(&a, &absx);
decNumberCopy(&d, &const_3);
for (i=0;i<500; i++) {
dn_multiply(&u, &t, &x2);
dn_divide(&t, &u, &d);
dn_add(&u, &a, &t);
if (dn_eq(&u, &a))
break;
decNumberCopy(&a, &u);
dn_p2(&d, &d);
}
decNumberCopy(&b, &const_0_5);
if (decNumberIsNegative(&x))
dn_minus(&a, &a);
} else {
const decNumber *nom, *extra, *sub;
//dn_minus(&x2, &absx);
//n = ceil(extra + nom / (|x| - sub))
if (is_usrdblmode()) {
sub = &const_1_5;
nom = &const_300;
extra = &const_8;
}
else {
sub = &const_1_3;
nom = &const_100;
extra = &const_4;
}
dn_subtract(&b, &absx, sub);
dn_divide(&t, nom, &b);
dn_add(&u, &t, extra);
decNumberCeil(&b, &u);
decNumberZero(&t);
do {
dn_add(&u, &x, &t);
dn_divide(&t, &b, &u);
dn_dec(&b);
} while (! dn_eq0(&b));
dn_add(&u, &t, &x);
decNumberRecip(&a, &u);
if (decNumberIsNegative(&a)) {
dn_minus(&a, &a);
decNumberZero(&b);
} else {
dn_1(&b);
dn_minus(&a, &a);
}
}
pdf_Q(&t, &x);
setXYZ(&t, &a, &b);
}
