GEN
addsi_sign(long x, GEN y, long sy)
{
long sx,ly;
GEN z;
if (!x) return icopy_sign(y, sy);
if (!sy) return stoi(x);
if (x<0) { sx=-1; x=-x; } else sx=1;
if (sx==sy)
{
z = adduispec(x,y+2, lgefint(y)-2);
setsigne(z,sy); return z;
}
ly=lgefint(y);
if (ly==3)
{
const long d = (long)(uel(y,2) - (ulong)x);
if (!d) return gen_0;
z=cgeti(3);
if (y[2] < 0 || d > 0) {
z[1] = evalsigne(sy) | evallgefint(3);
z[2] = d;
}
else {
z[1] = evalsigne(-sy) | evallgefint(3);
z[2] =-d;
}
return z;
}
z = subiuspec(y+2,x, ly-2);
setsigne(z,sy); return z;
}
/* return gen_0 when the sign is 0 */
GEN
addii_sign(GEN x, long sx, GEN y, long sy)
{
long lx,ly;
GEN z;
if (!sx) return sy? icopy_sign(y, sy): gen_0;
if (!sy) return icopy_sign(x, sx);
lx = lgefint(x);
ly = lgefint(y);
if (sx==sy)
z = addiispec(x+2,y+2,lx-2,ly-2);
else
{ /* sx != sy */
long i = cmpiispec(x+2,y+2,lx-2,ly-2);
if (!i) return gen_0;
/* we must ensure |x| > |y| for subiispec */
if (i < 0) {
sx = sy;
z = subiispec(y+2,x+2,ly-2,lx-2);
}
else
z = subiispec(x+2,y+2,lx-2,ly-2);
}
setsigne(z,sx); return z;
}
GEN
addui_sign(ulong x, GEN y, long sy)
{
long ly;
GEN z;
if (!x) return icopy_sign(y, sy);
if (!sy) return utoipos(x);
if (sy == 1) return adduispec(x,y+2, lgefint(y)-2);
ly=lgefint(y);
if (ly==3)
{
const ulong t = y[2];
if (x == t) return gen_0;
z=cgeti(3);
if (x < t) {
z[1] = evalsigne(-1) | evallgefint(3);
z[2] = t - x;
}
else {
z[1] = evalsigne(1) | evallgefint(3);
z[2] = x - t;
}
return z;
}
z = subiuspec(y+2,x, ly-2);
setsigne(z,-1); return z;
}
INLINE GEN
icopy_sign(GEN x, long sx)
{
GEN y=icopy(x);
setsigne(y,sx);
return y;
}
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;
}
MP_Status_t IMP_GetPariBigInt(MP_Link_pt link, MP_ApInt_t *mp_number)
{
long length, sign = 1;
GEN number, ptr;
/* first, we get the effective length and the sign */
ERR_CHK(IMP_GetLong(link, &length));
if (length < 0)
{
sign = -1;
length = -length;
}
else if (length == 0)
{
sign = 0;
}
/* Initialize the number */
number = IMP_AllocCgeti(length+2);
setlgef(number, length+2);
setsigne(number, sign);
/* Get the actual data */
if (length > 0)
{
if (link->link_bigint_format == MP_PARI)
{
ptr = &(number[2]);
ERR_CHK(IMP_GetUint32Vector(link, (MP_Uint32_t **) &ptr, length));
}
else
{
number++;
ptr = number + length;
for (; ptr > number; ptr--)
ERR_CHK(IMP_GetLong(link, ptr));
number--;
}
}
*mp_number = (MP_ApInt_t) number;
return MP_ClearError(link);
}
GEN _gmp_to_pari(mpz_ptr gnum)
{
long length = gnum->_mp_size;
long sign = (length < 0 ? -1 : (length == 0 ? 0 : 1));
GEN pnum, pptr;
mp_limb_t *gptr;
if (length < 0 ) length = -length;
pnum = IMP_AllocCgeti(length + 2);
setlgef(pnum, length + 2);
setsigne(pnum, sign);
pnum++;
pptr = pnum + length;
gptr = gnum->_mp_d;
for (; pptr > pnum; gptr++, pptr--)
*pptr = *gptr;
pnum--;
return pnum;
}
int
ratlift(GEN x, GEN m, GEN *a, GEN *b, GEN amax, GEN bmax)
{
GEN d,d1,v,v1,q,r;
pari_sp av = avma, av1, lim;
long lb,lr,lbb,lbr,s,s0;
ulong vmax;
ulong xu,xu1,xv,xv1; /* Lehmer stage recurrence matrix */
int lhmres; /* Lehmer stage return value */
if ((typ(x) | typ(m) | typ(amax) | typ(bmax)) != t_INT) pari_err(arither1);
if (signe(bmax) <= 0)
pari_err(talker, "ratlift: bmax must be > 0, found\n\tbmax=%Z\n", bmax);
if (signe(amax) < 0)
pari_err(talker, "ratilft: amax must be >= 0, found\n\tamax=%Z\n", amax);
/* check 2*amax*bmax < m */
if (cmpii(shifti(mulii(amax, bmax), 1), m) >= 0)
pari_err(talker, "ratlift: must have 2*amax*bmax < m, found\n\tamax=%Z\n\tbmax=%Z\n\tm=%Z\n", amax,bmax,m);
/* we _could_ silently replace x with modii(x,m) instead of the following,
* but let's leave this up to the caller
*/
avma = av; s = signe(x);
if (s < 0 || cmpii(x,m) >= 0)
pari_err(talker, "ratlift: must have 0 <= x < m, found\n\tx=%Z\n\tm=%Z\n", x,m);
/* special cases x=0 and/or amax=0 */
if (s == 0)
{
if (a != NULL) *a = gen_0;
if (b != NULL) *b = gen_1;
return 1;
}
else if (signe(amax)==0)
return 0;
/* assert: m > x > 0, amax > 0 */
/* check here whether a=x, b=1 is a solution */
if (cmpii(x,amax) <= 0)
{
if (a != NULL) *a = icopy(x);
if (b != NULL) *b = gen_1;
return 1;
}
/* There is no special case for single-word numbers since this is
* mainly meant to be used with large moduli.
*/
(void)new_chunk(lgefint(bmax) + lgefint(amax)); /* room for a,b */
d = m; d1 = x;
v = gen_0; v1 = gen_1;
/* assert d1 > amax, v1 <= bmax here */
lb = lgefint(bmax);
lbb = bfffo(*int_MSW(bmax));
s = 1;
av1 = avma; lim = stack_lim(av, 1);
/* general case: Euclidean division chain starting with m div x, and
* with bounds on the sequence of convergents' denoms v_j.
* Just to be different from what invmod and bezout are doing, we work
* here with the all-nonnegative matrices [u,u1;v,v1]=prod_j([0,1;1,q_j]).
* Loop invariants:
* (a) (sign)*[-v,v1]*x = [d,d1] (mod m) (componentwise)
* (sign initially +1, changes with each Euclidean step)
* so [a,b] will be obtained in the form [-+d,v] or [+-d1,v1];
* this congruence is a consequence of
* (b) [x,m]~ = [u,u1;v,v1]*[d1,d]~,
* where u,u1 is the usual numerator sequence starting with 1,0
* instead of 0,1 (just multiply the eqn on the left by the inverse
* matrix, which is det*[v1,-u1;-v,u], where "det" is the same as the
* "(sign)" in (a)). From m = v*d1 + v1*d and
* (c) d > d1 >= 0, 0 <= v < v1,
* we have d >= m/(2*v1), so while v1 remains smaller than m/(2*amax),
* the pair [-(sign)*d,v] satisfies (1) but violates (2) (d > amax).
* Conversely, v1 > bmax indicates that no further solutions will be
* forthcoming; [-(sign)*d,v] will be the last, and first, candidate.
* Thus there's at most one point in the chain division where a solution
* can live: v < bmax, v1 >= m/(2*amax) > bmax, and this is acceptable
* iff in fact d <= amax (e.g. m=221, x=34 or 35, amax=bmax=10 fail on
* this count while x=32,33,36,37 succeed). However, a division may leave
* a zero residue before we ever reach this point (consider m=210, x=35,
* amax=bmax=10), and our caller may find that gcd(d,v) > 1 (numerous
* examples -- keep m=210 and consider any of x=29,31,32,33,34,36,37,38,
* 39,40,41).
* Furthermore, at the start of the loop body we have in fact
* (c') 0 <= v < v1 <= bmax, d > d1 > amax >= 0,
* (and are never done already).
*
* Main loop is similar to those of invmod() and bezout(), except for
* having to determine appropriate vmax bounds, and checking termination
* conditions. The signe(d1) condition is only for paranoia
*/
while (lgefint(d) > 3 && signe(d1))
{
/* determine vmax for lgcdii so as to ensure v won't overshoot.
* If v+v1 > bmax, the next step would take v1 beyond the limit, so
* since [+-d1,v1] is not a solution, we give up. Otherwise if v+v1
* is way shorter than bmax, use vmax=MAXULUNG. Otherwise, set vmax
* to a crude lower approximation of bmax/(v+v1), or to 1, which will
* allow the inner loop to do one step
*/
r = addii(v,v1);
lr = lb - lgefint(r);
lbr = bfffo(*int_MSW(r));
if (cmpii(r,bmax) > 0) /* done, not found */
{
avma = av;
return 0;
}
else if (lr > 1) /* still more than a word's worth to go */
{
vmax = MAXULONG;
}
else /* take difference of bit lengths */
{
lr = (lr << TWOPOTBITS_IN_LONG) - lbb + lbr;
if ((ulong)lr > BITS_IN_LONG)
vmax = MAXULONG;
else if (lr == 0)
vmax = 1UL;
else
vmax = 1UL << (lr-1);
/* the latter is pessimistic but faster than a division */
}
/* do a Lehmer-Jebelean round */
lhmres = lgcdii((ulong *)d, (ulong *)d1, &xu, &xu1, &xv, &xv1, vmax);
if (lhmres != 0) /* check progress */
{ /* apply matrix */
if ((lhmres == 1) || (lhmres == -1))
{
s = -s;
if (xv1 == 1)
{
/* re-use v+v1 computed above */
v=v1; v1=r;
r = subii(d,d1); d=d1; d1=r;
}
else
{
r = subii(d, mului(xv1,d1)); d=d1; d1=r;
r = addii(v, mului(xv1,v1)); v=v1; v1=r;
}
}
else
{
r = subii(muliu(d,xu), muliu(d1,xv));
d1 = subii(muliu(d,xu1), muliu(d1,xv1)); d = r;
r = addii(muliu(v,xu), muliu(v1,xv));
v1 = addii(muliu(v,xu1), muliu(v1,xv1)); v = r;
if (lhmres&1)
{
setsigne(d,-signe(d));
s = -s;
}
else if (signe(d1))
{
setsigne(d1,-signe(d1));
}
}
/* check whether we're done. Assert v <= bmax here. Examine v1:
* if v1 > bmax, check d and return 0 or 1 depending on the outcome;
* if v1 <= bmax, check d1 and return 1 if d1 <= amax, otherwise
* proceed.
*/
if (cmpii(v1,bmax) > 0) /* certainly done */
{
avma = av;
if (cmpii(d,amax) <= 0) /* done, found */
{
if (a != NULL)
{
*a = icopy(d);
setsigne(*a,-s); /* sign opposite to s */
}
if (b != NULL) *b = icopy(v);
return 1;
}
else /* done, not found */
return 0;
}
else if (cmpii(d1,amax) <= 0) /* also done, found */
{
avma = av;
if (a != NULL)
{
if (signe(d1))
{
*a = icopy(d1);
setsigne(*a,s); /* same sign as s */
}
else
*a = gen_0;
}
if (b != NULL) *b = icopy(v1);
return 1;
}
} /* lhmres != 0 */
if (lhmres <= 0 && signe(d1))
{
q = dvmdii(d,d1,&r);
#ifdef DEBUG_LEHMER
fprintferr("Full division:\n");
printf(" q = "); output(q); sleep (1);
#endif
d=d1; d1=r;
r = addii(v,mulii(q,v1));
v=v1; v1=r;
s = -s;
/* check whether we are done now. Since we weren't before the div, it
* suffices to examine v1 and d1 -- the new d (former d1) cannot cut it
*/
if (cmpii(v1,bmax) > 0) /* done, not found */
{
avma = av;
return 0;
}
else if (cmpii(d1,amax) <= 0) /* done, found */
{
avma = av;
if (a != NULL)
{
if (signe(d1))
{
*a = icopy(d1);
setsigne(*a,s); /* same sign as s */
}
else
*a = gen_0;
}
if (b != NULL) *b = icopy(v1);
return 1;
}
}
if (low_stack(lim, stack_lim(av,1)))
{
GEN *gptr[4]; gptr[0]=&d; gptr[1]=&d1; gptr[2]=&v; gptr[3]=&v1;
if(DEBUGMEM>1) pari_warn(warnmem,"ratlift");
gerepilemany(av1,gptr,4);
}
} /* end while */
/* Postprocessing - final sprint. Since we usually underestimate vmax,
* this function needs a loop here instead of a simple conditional.
* Note we can only get here when amax fits into one word (which will
* typically not be the case!). The condition is bogus -- d1 is never
* zero at the start of the loop. There will be at most a few iterations,
* so we don't bother collecting garbage
*/
while (signe(d1))
{
/* Assertions: lgefint(d)==lgefint(d1)==3.
* Moreover, we aren't done already, or we would have returned by now.
* Recompute vmax...
*/
#ifdef DEBUG_RATLIFT
fprintferr("rl-fs: d,d1=%Z,%Z\n", d, d1);
fprintferr("rl-fs: v,v1=%Z,%Z\n", v, v1);
#endif
r = addii(v,v1);
lr = lb - lgefint(r);
lbr = bfffo(*int_MSW(r));
if (cmpii(r,bmax) > 0) /* done, not found */
{
avma = av;
return 0;
}
else if (lr > 1) /* still more than a word's worth to go */
{
vmax = MAXULONG; /* (cannot in fact happen) */
}
else /* take difference of bit lengths */
{
lr = (lr << TWOPOTBITS_IN_LONG) - lbb + lbr;
if ((ulong)lr > BITS_IN_LONG)
vmax = MAXULONG;
else if (lr == 0)
vmax = 1UL;
else
vmax = 1UL << (lr-1); /* as above */
}
#ifdef DEBUG_RATLIFT
fprintferr("rl-fs: vmax=%lu\n", vmax);
#endif
/* single-word "Lehmer", discarding the gcd or whatever it returns */
(void)rgcduu((ulong)*int_MSW(d), (ulong)*int_MSW(d1), vmax, &xu, &xu1, &xv, &xv1, &s0);
#ifdef DEBUG_RATLIFT
fprintferr("rl-fs: [%lu,%lu; %lu,%lu] %s\n",
xu, xu1, xv, xv1,
s0 < 0 ? "-" : "+");
#endif
if (xv1 == 1) /* avoid multiplications */
{
/* re-use v+v1 computed above */
v=v1; v1=r;
r = subii(d,d1); d=d1; d1=r;
s = -s;
}
else if (xu == 0) /* and xv==1, xu1==1, xv1 > 1 */
{
r = subii(d, mului(xv1,d1)); d=d1; d1=r;
r = addii(v, mului(xv1,v1)); v=v1; v1=r;
s = -s;
}
else
{
r = subii(muliu(d,xu), muliu(d1,xv));
d1 = subii(muliu(d,xu1), muliu(d1,xv1)); d = r;
r = addii(muliu(v,xu), muliu(v1,xv));
v1 = addii(muliu(v,xu1), muliu(v1,xv1)); v = r;
if (s0 < 0)
{
setsigne(d,-signe(d));
s = -s;
}
else if (signe(d1)) /* sic: might vanish now */
{
setsigne(d1,-signe(d1));
}
}
/* check whether we're done, as above. Assert v <= bmax. Examine v1:
* if v1 > bmax, check d and return 0 or 1 depending on the outcome;
* if v1 <= bmax, check d1 and return 1 if d1 <= amax, otherwise proceed.
*/
if (cmpii(v1,bmax) > 0) /* certainly done */
{
avma = av;
if (cmpii(d,amax) <= 0) /* done, found */
{
if (a != NULL)
{
*a = icopy(d);
setsigne(*a,-s); /* sign opposite to s */
}
if (b != NULL) *b = icopy(v);
return 1;
}
else /* done, not found */
return 0;
}
else if (cmpii(d1,amax) <= 0) /* also done, found */
{
avma = av;
if (a != NULL)
{
if (signe(d1))
{
*a = icopy(d1);
setsigne(*a,s); /* same sign as s */
}
else
*a = gen_0;
}
if (b != NULL) *b = icopy(v1);
return 1;
}
} /* while */
/* get here when we have run into d1 == 0 before returning... in fact,
* this cannot happen.
*/
pari_err(talker, "ratlift failed to catch d1 == 0\n");
/* NOTREACHED */
return 0;
}
int
invmod(GEN a, GEN b, GEN *res)
#endif
{
GEN v,v1,d,d1,q,r;
pari_sp av, av1, lim;
long s;
ulong g;
ulong xu,xu1,xv,xv1; /* Lehmer stage recurrence matrix */
int lhmres; /* Lehmer stage return value */
if (typ(a) != t_INT || typ(b) != t_INT) pari_err(arither1);
if (!signe(b)) { *res=absi(a); return 0; }
av = avma;
if (lgefint(b) == 3) /* single-word affair */
{
ulong d1 = umodiu(a, (ulong)(b[2]));
if (d1 == 0)
{
if (b[2] == 1L)
{ *res = gen_0; return 1; }
else
{ *res = absi(b); return 0; }
}
g = xgcduu((ulong)(b[2]), d1, 1, &xv, &xv1, &s);
#ifdef DEBUG_LEHMER
fprintferr(" <- %lu,%lu\n", (ulong)(b[2]), (ulong)(d1[2]));
fprintferr(" -> %lu,%ld,%lu; %lx\n", g,s,xv1,avma);
#endif
avma = av;
if (g != 1UL) { *res = utoipos(g); return 0; }
xv = xv1 % (ulong)(b[2]); if (s < 0) xv = ((ulong)(b[2])) - xv;
*res = utoipos(xv); return 1;
}
(void)new_chunk(lgefint(b));
d = absi(b); d1 = modii(a,d);
v=gen_0; v1=gen_1; /* general case */
#ifdef DEBUG_LEHMER
fprintferr("INVERT: -------------------------\n");
output(d1);
#endif
av1 = avma; lim = stack_lim(av,1);
while (lgefint(d) > 3 && signe(d1))
{
#ifdef DEBUG_LEHMER
fprintferr("Calling Lehmer:\n");
#endif
lhmres = lgcdii((ulong*)d, (ulong*)d1, &xu, &xu1, &xv, &xv1, MAXULONG);
if (lhmres != 0) /* check progress */
{ /* apply matrix */
#ifdef DEBUG_LEHMER
fprintferr("Lehmer returned %d [%lu,%lu;%lu,%lu].\n",
lhmres, xu, xu1, xv, xv1);
#endif
if ((lhmres == 1) || (lhmres == -1))
{
if (xv1 == 1)
{
r = subii(d,d1); d=d1; d1=r;
a = subii(v,v1); v=v1; v1=a;
}
else
{
r = subii(d, mului(xv1,d1)); d=d1; d1=r;
a = subii(v, mului(xv1,v1)); v=v1; v1=a;
}
}
else
{
r = subii(muliu(d,xu), muliu(d1,xv));
a = subii(muliu(v,xu), muliu(v1,xv));
d1 = subii(muliu(d,xu1), muliu(d1,xv1)); d = r;
v1 = subii(muliu(v,xu1), muliu(v1,xv1)); v = a;
if (lhmres&1)
{
setsigne(d,-signe(d));
setsigne(v,-signe(v));
}
else
{
if (signe(d1)) { setsigne(d1,-signe(d1)); }
setsigne(v1,-signe(v1));
}
}
}
#ifdef DEBUG_LEHMER
else
fprintferr("Lehmer returned 0.\n");
output(d); output(d1); output(v); output(v1);
sleep(1);
#endif
if (lhmres <= 0 && signe(d1))
{
q = dvmdii(d,d1,&r);
#ifdef DEBUG_LEHMER
fprintferr("Full division:\n");
printf(" q = "); output(q); sleep (1);
#endif
a = subii(v,mulii(q,v1));
v=v1; v1=a;
d=d1; d1=r;
}
if (low_stack(lim, stack_lim(av,1)))
{
GEN *gptr[4]; gptr[0]=&d; gptr[1]=&d1; gptr[2]=&v; gptr[3]=&v1;
if(DEBUGMEM>1) pari_warn(warnmem,"invmod");
gerepilemany(av1,gptr,4);
}
} /* end while */
/* Postprocessing - final sprint */
if (signe(d1))
{
/* Assertions: lgefint(d)==lgefint(d1)==3, and
* gcd(d,d1) is nonzero and fits into one word
*/
g = xxgcduu((ulong)d[2], (ulong)d1[2], 1, &xu, &xu1, &xv, &xv1, &s);
#ifdef DEBUG_LEHMER
output(d);output(d1);output(v);output(v1);
fprintferr(" <- %lu,%lu\n", (ulong)d[2], (ulong)d1[2]);
fprintferr(" -> %lu,%ld,%lu; %lx\n", g,s,xv1,avma);
#endif
if (g != 1UL) { avma = av; *res = utoipos(g); return 0; }
/* (From the xgcduu() blurb:)
* For finishing the multiword modinv, we now have to multiply the
* returned matrix (with properly adjusted signs) onto the values
* v' and v1' previously obtained from the multiword division steps.
* Actually, it is sufficient to take the scalar product of [v',v1']
* with [u1,-v1], and change the sign if s==1.
*/
v = subii(muliu(v,xu1),muliu(v1,xv1));
if (s > 0) setsigne(v,-signe(v));
avma = av; *res = modii(v,b);
#ifdef DEBUG_LEHMER
output(*res); fprintfderr("============================Done.\n");
sleep(1);
#endif
return 1;
}
/* get here when the final sprint was skipped (d1 was zero already) */
avma = av;
if (!equalii(d,gen_1)) { *res = icopy(d); return 0; }
*res = modii(v,b);
#ifdef DEBUG_LEHMER
output(*res); fprintferr("============================Done.\n");
sleep(1);
#endif
return 1;
}
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;
}
