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