static GEN
addsr_sign(long x, GEN y, long sy)
{
long e, l, ly, sx;
GEN z;
if (!x) return rcopy_sign(y, sy);
if (x < 0) { sx = -1; x = -x; } else sx = 1;
e = expo(y) - expu(x);
if (!sy)
{
if (e >= 0) return rcopy_sign(y, sy);
if (sx == -1) x = -x;
return stor(x, nbits2prec(-e));
}
ly = lg(y);
if (e > 0)
{
l = ly - divsBIL(e);
if (l < 3) return rcopy_sign(y, sy);
}
else l = ly + nbits2extraprec(-e);
z = (GEN)avma;
y = addrr_sign(stor(x,l), sx, y, sy);
ly = lg(y); while (ly--) *--z = y[ly];
avma = (pari_sp)z; return z;
}
GEN
addir_sign(GEN x, long sx, GEN y, long sy)
{
long e, l, ly;
GEN z;
if (!sx) return rcopy_sign(y, sy);
e = expo(y) - expi(x);
if (!sy)
{
if (e >= 0) return rcopy_sign(y, sy);
z = itor(x, nbits2prec(-e));
setsigne(z, sx); return z;
}
ly = lg(y);
if (e > 0)
{
l = ly - divsBIL(e);
if (l < 3) return rcopy_sign(y, sy);
}
else l = ly + nbits2extraprec(-e);
z = (GEN)avma;
y = addrr_sign(itor(x,l), sx, y, sy);
ly = lg(y); while (ly--) *--z = y[ly];
avma = (pari_sp)z; return z;
}
static GEN
real_read(pari_sp av, const char **s, GEN y, long prec)
{
long l, n = 0;
switch(**s)
{
default: return y; /* integer */
case '.':
{
const char *old = ++*s;
if (isalpha((int)**s) || **s=='.')
{
if (**s == 'E' || **s == 'e') {
n = exponent(s);
if (!signe(y)) { avma = av; return real_0_digits(n); }
break;
}
--*s; return y; /* member */
}
y = int_read_more(y, s);
n = old - *s;
if (**s != 'E' && **s != 'e')
{
if (!signe(y)) { avma = av; return real_0(prec); }
break;
}
}
/* Fall through */
case 'E': case 'e':
n += exponent(s);
if (!signe(y)) { avma = av; return real_0_digits(n); }
}
l = nbits2prec(bit_accuracy(lgefint(y)));
if (l < prec) l = prec; else prec = l;
if (!n) return itor(y, prec);
incrprec(l);
y = itor(y, l);
if (n > 0)
y = mulrr(y, rpowuu(10UL, (ulong)n, l));
else
y = divrr(y, rpowuu(10UL, (ulong)-n, l));
return gerepileuptoleaf(av, rtor(y, prec));
}
GEN
addrr_sign(GEN x, long sx, GEN y, long sy)
{
long lx, ex = expo(x);
long ly, ey = expo(y), e = ey - ex;
long i, j, lz, ez, m;
int extend, f2;
GEN z;
LOCAL_OVERFLOW;
if (!sy)
{
if (!sx)
{
if (e > 0) ex = ey;
return real_0_bit(ex);
}
if (e >= 0) return real_0_bit(ey);
lz = nbits2prec(-e);
lx = lg(x); if (lz > lx) lz = lx;
z = cgetr(lz); while(--lz) z[lz] = x[lz];
setsigne(z,sx); return z;
}
if (!sx)
{
if (e <= 0) return real_0_bit(ex);
lz = nbits2prec(e);
ly = lg(y); if (lz > ly) lz = ly;
z = cgetr(lz); while (--lz) z[lz] = y[lz];
setsigne(z,sy); return z;
}
if (e < 0) { swap(x,y); lswap(sx,sy); ey=ex; e=-e; }
/* now ey >= ex */
lx = lg(x);
ly = lg(y);
/* If exponents differ, need to shift one argument, here x. If
* extend = 1: extension of x,z by m < BIL bits (round to 1 word) */
/* in this case, lz = lx + d + 1, otherwise lx + d */
extend = 0;
if (e)
{
long d = dvmdsBIL(e, &m), l = ly-d;
if (l <= 2) return rcopy_sign(y, sy);
if (l > lx) { lz = lx + d + 1; extend = 1; }
else { lz = ly; lx = l; }
if (m)
{ /* shift x right m bits */
const pari_sp av = avma;
const ulong sh = BITS_IN_LONG-m;
GEN p1 = x; x = new_chunk(lx + lz + 1);
shift_right(x,p1,2,lx, 0,m);
if (extend) uel(x,lx) = uel(p1,lx-1) << sh;
avma = av; /* HACK: cgetr(lz) will not overwrite x */
}
}
else
{ /* d = 0 */
m = 0;
if (lx > ly) lx = ly;
lz = lx;
}
if (sx == sy)
{ /* addition */
i = lz-1;
j = lx-1;
if (extend) {
ulong garde = addll(x[lx], y[i]);
if (m < 4) /* don't extend for few correct bits */
z = cgetr(--lz);
else
{
z = cgetr(lz);
z[i] = garde;
}
}
else
{
z = cgetr(lz);
z[i] = addll(x[j], y[i]); j--;
}
i--;
for (; j>=2; i--,j--) z[i] = addllx(x[j],y[i]);
if (overflow)
{
z[1] = 1; /* stops since z[1] != 0 */
for (;;) { z[i] = uel(y,i)+1; if (z[i--]) break; }
if (i <= 0)
{
shift_right(z,z, 2,lz, 1,1);
z[1] = evalsigne(sx) | evalexpo(ey+1); return z;
}
}
for (; i>=2; i--) z[i] = y[i];
z[1] = evalsigne(sx) | evalexpo(ey); return z;
}
/* subtraction */
if (e) f2 = 1;
else
{
i = 2; while (i < lx && x[i] == y[i]) i++;
if (i==lx) return real_0_bit(ey+1 - prec2nbits(lx));
f2 = (uel(y,i) > uel(x,i));
}
/* result is non-zero. f2 = (y > x) */
i = lz-1; z = cgetr(lz);
if (f2)
{
j = lx-1;
if (extend) z[i] = subll(y[i], x[lx]);
else z[i] = subll(y[i], x[j--]);
for (i--; j>=2; i--) z[i] = subllx(y[i], x[j--]);
if (overflow) /* stops since y[1] != 0 */
for (;;) { z[i] = uel(y,i)-1; if (y[i--]) break; }
for (; i>=2; i--) z[i] = y[i];
sx = sy;
}
else
{
if (extend) z[i] = subll(x[lx], y[i]);
else z[i] = subll(x[i], y[i]);
for (i--; i>=2; i--) z[i] = subllx(x[i], y[i]);
}
x = z+2; i = 0; while (!x[i]) i++;
lz -= i; z += i;
j = bfffo(z[2]); /* need to shift left by j bits to normalize mantissa */
ez = ey - (j | (i * BITS_IN_LONG));
if (extend)
{ /* z was extended by d+1 words [should be e bits = d words + m bits] */
/* not worth keeping extra word if less than 5 significant bits in there */
if (m - j < 5 && lz > 3)
{ /* shorten z */
ulong last = (ulong)z[--lz]; /* cancelled word */
/* if we need to shift anyway, shorten from left
* If not, shorten from right, neutralizing last word of z */
if (j == 0)
/* stackdummy((pari_sp)(z + lz+1), (pari_sp)(z + lz)); */
z[lz] = evaltyp(t_VECSMALL) | _evallg(1);
else
{
GEN t = z;
z++; shift_left(z,t,2,lz-1, last,j);
}
if ((last<<j) & HIGHBIT)
{ /* round up */
i = lz-1;
while (++((ulong*)z)[i] == 0 && i > 1) i--;
if (i == 1) { ez++; z[2] = (long)HIGHBIT; }
}
}
else if (j) shift_left(z,z,2,lz-1, 0,j);
}
else if (j) shift_left(z,z,2,lz-1, 0,j);
z[1] = evalsigne(sx) | evalexpo(ez);
z[0] = evaltyp(t_REAL) | evallg(lz);
avma = (pari_sp)z; return z;
}
engine_RawRingElementArrayOrNull rawRoots(const RingElement *p, long prec,
int unique) {
const Ring *R = p->get_ring();
const PolynomialRing *P = R->cast_to_PolynomialRing();
if (P == 0) {
ERROR("expected a polynomial ring");
return NULL;
}
const int n = P->n_vars();
if (n != 1) {
ERROR("expected a univariate polynomial ring");
return NULL;
}
const Ring *K = P->getCoefficients();
int degree = 0;
for (Nterm *t = p->get_value(); t != NULL; t = t->next) {
degree = max(degree, abs(*(t->monom)));
}
if (prec == -1) {
prec = (K->get_precision() == 0 ? 53 : K->get_precision());
}
engine_RawRingElementArrayOrNull result = nullptr;
/* Start PARI computations. */
pari_CATCH(e_STACK) {
#ifdef NDEBUG
/*
* Every time the stack is changed PARI writes a message to the file pari_errfile
* which by default is /dev/stderr. To avoid showing this message to the user we
* redirect to /dev/null before the PARI's stack is modified.
*/
FILE *tmp, *dev_null = fopen("/dev/null", "w");
if (dev_null != NULL) {
tmp = pari_errfile;
pari_errfile = dev_null;
}
#endif
allocatemem(0); // passing 0 will double the current stack size.
#ifdef NDEBUG
/*
* We set pari_errfile back to the default value just in case PARI crashes.
*/
if (dev_null != NULL) {
pari_errfile = tmp;
fclose(dev_null);
}
#endif
} pari_RETRY {
const pari_sp av = avma;
GEN q = cgetg(2 + degree + 1, t_POL);
setsigne(q, 1);
setvarn(q, 0);
for (int i = 0; i < degree + 1; ++i) {
gel(q, 2 + i) = gen_0;
}
switch (K->ringID()) {
case M2::ring_ZZ:
ZZ_GMP:
for (Nterm *t = p->get_value(); t != NULL; t = t->next) {
gel(q, 2 + abs(*(t->monom))) =
mpz_get_GEN(reinterpret_cast<const mpz_ptr>(t->coeff.poly_val));
}
break;
case M2::ring_QQ:
for (Nterm *t = p->get_value(); t != NULL; t = t->next) {
gel(q, 2 + abs(*(t->monom))) =
mpq_get_GEN(reinterpret_cast<const mpq_ptr>(t->coeff.poly_val));
}
break;
case M2::ring_RR:
pari_CATCH(e_OVERFLOW) {
ERROR("coefficient is NaN or Infinity");
avma = av;
return NULL;
}
pari_TRY {
for (Nterm *t = p->get_value(); t != NULL; t = t->next) {
gel(q, 2 + abs(*(t->monom))) =
dbltor(*reinterpret_cast<double *>(t->coeff.poly_val));
}
}
pari_ENDCATCH
break;
case M2::ring_CC:
pari_CATCH(e_OVERFLOW) {
ERROR("coefficient is NaN or Infinity");
avma = av;
return NULL;
}
pari_TRY {
for (Nterm *t = p->get_value(); t != NULL; t = t->next) {
GEN z = cgetg(3, t_COMPLEX);
gel(z, 1) = dbltor(reinterpret_cast<complex *>(t->coeff.poly_val)->re);
gel(z, 2) = dbltor(reinterpret_cast<complex *>(t->coeff.poly_val)->im);
gel(q, 2 + abs(*(t->monom))) = z;
}
}
pari_ENDCATCH
break;
case M2::ring_RRR:
for (Nterm *t = p->get_value(); t != NULL; t = t->next) {
gel(q, 2 + abs(*(t->monom))) =
mpfr_get_GEN(reinterpret_cast<const mpfr_ptr>(t->coeff.poly_val));
}
break;
case M2::ring_CCC:
for (Nterm *t = p->get_value(); t != NULL; t = t->next) {
gel(q, 2 + abs(*(t->monom))) =
mpc_get_GEN(reinterpret_cast<const mpc_ptr>(t->coeff.poly_val));
}
break;
case M2::ring_old:
if (K->is_ZZ()) {
goto ZZ_GMP;
}
default:
ERROR("expected coefficient ring of the form ZZ, QQ, RR or CC");
return NULL;
}
if (unique) {
q = RgX_div(q, RgX_gcd_simple(q, RgX_deriv(q)));
}
GEN roots = cleanroots(q, nbits2prec(prec));
const size_t num_roots = lg(roots) - 1;
result = getmemarraytype(engine_RawRingElementArray, num_roots);
result->len = static_cast<int>(num_roots);
ring_elem m2_root;
if (prec <= 53) {
const RingCC *CC = dynamic_cast<const RingCC *>(IM2_Ring_CCC(prec));
for (int i = 0; i < num_roots; ++i) {
const pari_sp av2 = avma;
GEN pari_root = gel(roots, 1 + i);
const complex root = {rtodbl(greal(pari_root)),
rtodbl(gimag(pari_root))};
CC->ring().to_ring_elem(m2_root, root);
result->array[i] = RingElement::make_raw(CC, m2_root);
avma = av2;
}
} else {
const RingCCC *CCC = dynamic_cast<const RingCCC *>(IM2_Ring_CCC(prec));
for (int i = 0; i < num_roots; ++i) {
const pari_sp av2 = avma;
mpc_t root;
auto root1 = reinterpret_cast<mpfc_t*>(&root);
pari_mpc_init_set_GEN(root, gel(roots, 1 + i), GMP_RNDN);
// CCC->ring().to_ring_elem(m2_root, **reinterpret_cast<mpfc_t*>(&root));
CCC->ring().to_ring_elem(m2_root, **root1);
result->array[i] = RingElement::make_raw(CCC, m2_root);
avma = av2;
}
}
/* End PARI computations. */
avma = av;
}
pari_ENDCATCH
return result;
}
