GEN
gcdii(GEN a, GEN b)
{
long v, w;
pari_sp av;
GEN t;
switch (absi_cmp(a,b))
{
case 0: return absi(a);
case -1: swap(a,b);
}
if (!signe(b)) return absi(a);
/* here |a|>|b|>0. Try single precision first */
if (lgefint(a)==3)
return igcduu((ulong)a[2], (ulong)b[2]);
if (lgefint(b)==3)
{
ulong u = resiu(a,(ulong)b[2]);
if (!u) return absi(b);
return igcduu((ulong)b[2], u);
}
/* larger than gcd: "avma=av" gerepile (erasing t) is valid */
av = avma; (void)new_chunk(lgefint(b)+1); /* HACK */
t = remii(a,b);
if (!signe(t)) { avma=av; return absi(b); }
a = b; b = t;
v = vali(a); a = shifti(a,-v); setabssign(a);
w = vali(b); b = shifti(b,-w); setabssign(b);
if (w < v) v = w;
switch(absi_cmp(a,b))
{
case 0: avma=av; a=shifti(a,v); return a;
case -1: swap(a,b);
}
if (is_pm1(b)) { avma=av; return int2n(v); }
{
/* general case */
/*This serve two purposes: 1) mpn_gcd destroy its input and need an extra
* limb 2) this allows us to use icopy instead of gerepile later. NOTE: we
* must put u before d else the final icopy could fail.
*/
GEN res= cgeti(lgefint(a)+1);
GEN ca = icopy_ef(a,lgefint(a)+1);
GEN cb = icopy_ef(b,lgefint(b)+1);
long l = mpn_gcd(LIMBS(res), LIMBS(ca), NLIMBS(ca), LIMBS(cb), NLIMBS(cb));
res[1] = evalsigne(1)|evallgefint(l+2);
avma=av;
return shifti(res,v);
}
}
static GEN
makepoldeg1(GEN c, GEN d)
{
GEN z;
if (signe(c)) {
z = cgetg(4,t_POL); z[1] = evalsigne(1);
gel(z,2) = d; gel(z,3) = c;
} else if (signe(d)) {
z = cgetg(3,t_POL); z[1] = evalsigne(1);
gel(z,2) = d;
} else {
z = cgetg(2,t_POL); z[1] = evalsigne(0);
}
return z;
}
char *ft_itoa(int n)
{
int tmp;
int len;
char *str;
int min;
tmp = n;
if (n == 0 || n == -2147483648)
return (func_zero(n));
len = (n < 0) ? ft_ilong(tmp) + 1 : ft_ilong(tmp);
str = ft_strnew((size_t)len + 1);
if (str == NULL)
return (NULL);
min = (n < 0) ? 1 : 0;
signe(&n, str);
while (len >= min)
{
tmp = n % 10;
str[len] = '0' + tmp;
n /= 10;
len--;
}
return (str);
}
mpz_ptr _pari_to_gmp(GEN pnum, mpz_ptr *gnum_ptr)
{
mpz_ptr gnum;
long length = lgef(pnum) - 2;
long sign = signe(pnum);
GEN pptr;
mp_limb_t *gptr;
if (*gnum_ptr == NULL)
{
*gnum_ptr = (mpz_ptr) IMP_MemAllocFnc(sizeof(__mpz_struct));
gnum = *gnum_ptr;
mpz_init(gnum);
}
else
gnum = *gnum_ptr;
gnum->_mp_size = (sign < 0 ? -length : length);
_mpz_realloc(gnum, length);
gnum->_mp_alloc = length;
gptr = gnum->_mp_d;
pnum++;
pptr = pnum + length;
for (; pptr > pnum; gptr++, pptr--)
*gptr = *pptr;
return gnum;
}
static long
nfislocalpower_i(GEN nf, GEN pr, GEN a, GEN n)
{
long v, e, t;
GEN p, G;
a = nf_to_scalar_or_basis(nf,a);
checkprid(pr);
if (!signe(n)) return isint1(a);
v = nfvalrem(nf, a, pr, &a);
p = pr_get_p(pr);
if (!dvdsi(v, n)) return 0;
v = Z_pvalrem(n, p, &n);
if (!equali1(n))
{
GEN T, modpr = zk_to_Fq_init(nf, &pr, &T, &p);
GEN ap = nf_to_Fq(nf, a, modpr);
if (!Fq_ispower(ap, n, T, p)) return 0;
}
if (!v) return 1;
e = pr_get_e(pr);
if (v == 1) /* optimal formula */
t = itos( divii(mului(e,p), subiu(p,1)) ) + 1;
else /* straight Hensel */
t = 2 * e * v + 1;
G = Idealstarprk(nf, pr, t, nf_INIT);
return (ZV_pval(ideallog(nf, a, G), p) >= v);
}
MP_Status_t IMP_PutPariBigInt(MP_Link_pt link, MP_ApInt_t mp_number)
{
GEN number = (GEN) mp_number;
long length = lgef(number) - 2; /* in "limbs" */
long sign = signe(number);
/* Put the length and sign */
ERR_CHK(IMP_PutSint32(link, (sign < 0 ? -length : length)));
if (link->link_bigint_format == MP_PARI)
{
/* for pari - bigints can use the vector put */
ERR_CHK(IMP_PutUint32Vector(link, (MP_Uint32_t *) &number[2], length));
}
else
{
/* we put the numbers in the gmp format */
/* which is very similar to the pari format, except that in pari,
limbs are in descending order, and not in ascending, as in gmp */
GEN ptr = number + length + 1;
number++;
for (;ptr > number; ptr--)
ERR_CHK(IMP_PutLong(link, ptr));
}
/* done */
return MP_ClearError(link);
}
/* x t_POL, n > 0. Return x mod polcyclo(2^n) = (x^(2^(n-1)) + 1). IN PLACE */
static GEN
red_cyclo2n_ip(GEN x, long n)
{
long i, pow2 = 1L<<(n-1);
for (i = lg(x)-1; i>pow2+1; i--)
if (signe(gel(x,i))) gel(x,i-pow2) = subii(gel(x,i-pow2), gel(x,i));
return normalizepol_lg(x, i+1);
}
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));
}
static GEN
_F2xqE_mul(void *E, GEN P, GEN n)
{
pari_sp av = avma;
struct _F2xqE *e=(struct _F2xqE *) E;
long s = signe(n);
if (!s || ell_is_inf(P)) return ellinf();
if (s<0) P = F2xqE_neg(P, e->a2, e->T);
if (is_pm1(n)) return s>0? gcopy(P): P;
return gerepileupto(av, gen_pow(P, n, e, &_F2xqE_dbl, &_F2xqE_add));
}
void t_INT_to_ZZ ( mpz_t value, GEN g )
{
long limbs = 0;
limbs = lgefint(g) - 2;
mpz_realloc2( value, limbs );
mpz_import( value, limbs, -1, sizeof(long), 0, 0, int_LSW(g) );
if ( signe(g) == -1 )
mpz_neg( value, value );
return;
}
/* return P(X + c) using destructive Horner, optimize for c = 1,-1 */
GEN
translate_pol(GEN P, GEN c)
{
pari_sp av = avma, lim;
GEN Q, *R;
long i, k, n;
if (!signe(P) || gcmp0(c)) return gcopy(P);
Q = shallowcopy(P);
R = (GEN*)(Q+2); n = degpol(P);
lim = stack_lim(av, 2);
if (gcmp1(c))
{
for (i=1; i<=n; i++)
{
for (k=n-i; k<n; k++) R[k] = gadd(R[k], R[k+1]);
if (low_stack(lim, stack_lim(av,2)))
{
if(DEBUGMEM>1) pari_warn(warnmem,"TR_POL(1), i = %ld/%ld", i,n);
Q = gerepilecopy(av, Q); R = (GEN*)Q+2;
}
}
}
else if (gcmp_1(c))
{
for (i=1; i<=n; i++)
{
for (k=n-i; k<n; k++) R[k] = gsub(R[k], R[k+1]);
if (low_stack(lim, stack_lim(av,2)))
{
if(DEBUGMEM>1) pari_warn(warnmem,"TR_POL(-1), i = %ld/%ld", i,n);
Q = gerepilecopy(av, Q); R = (GEN*)Q+2;
}
}
}
else
{
for (i=1; i<=n; i++)
{
for (k=n-i; k<n; k++) R[k] = gadd(R[k], gmul(c, R[k+1]));
if (low_stack(lim, stack_lim(av,2)))
{
if(DEBUGMEM>1) pari_warn(warnmem,"TR_POL, i = %ld/%ld", i,n);
Q = gerepilecopy(av, Q); R = (GEN*)Q+2;
}
}
}
return gerepilecopy(av, Q);
}
int padding(t_printf *p)
{
char s[32];
if (p->pad < 0)
p->pad = 0;
if (p->flag & F_ZERO && (p->flag & (C_INT | C_LONG)))
signe(p);
ft_memset(s, p->flag & F_ZERO ? '0' : ' ', 32);
while (p->pad > 32)
{
write(p->fd, s, 32);
p->pad -= 32;
p->len += 32;
}
p->len += write(p->fd, s, p->pad);
return (1);
}
// Digit reversal
GEN
rev(GEN n, long B)
{
pari_sp av = avma;
if (typ(n) != t_INT)
pari_err_TYPE("rev", n);
GEN m = modis(n, B);
n = divis(n, B);
pari_sp btop = avma, st_lim = stack_lim(btop, 1);
while (signe(n)) {
m = addis(mulis(m, B), smodis(n, B));
n = divis(n, B);
if (low_stack(st_lim, stack_lim(btop, 1)))
gerepileall(btop, 2, &m, &n);
}
m = gerepilecopy(av, m);
return m;
}
/* return d = gcd(a,b), sets u, v such that au + bv = gcd(a,b) */
GEN
extgcd(GEN A, GEN B, GEN *U, GEN *V)
{
pari_sp av = avma;
GEN ux = gen_1, vx = gen_0, a = A, b = B;
if (typ(a) != t_INT) pari_err_TYPE("extgcd",a);
if (typ(b) != t_INT) pari_err_TYPE("extgcd",b);
if (signe(a) < 0) { a = negi(a); ux = negi(ux); }
while (!gequal0(b))
{
GEN r, q = dvmdii(a, b, &r), v = vx;
vx = subii(ux, mulii(q, vx));
ux = v; a = b; b = r;
}
*U = ux;
*V = diviiexact( subii(a, mulii(A,ux)), B );
gerepileall(av, 3, &a, U, V); return a;
}
GEN
shallowextract(GEN x, GEN L)
{
long i,j, tl = typ(L), tx = typ(x), lx = lg(x);
GEN y;
switch(tx)
{
case t_VEC:
case t_COL:
case t_MAT:
case t_VECSMALL: break;
default: pari_err_TYPE("extract",x);
}
if (tl==t_INT)
{ /* extract components of x as per the bits of mask L */
long k, l, ix, iy, maxj;
GEN Ld;
if (!signe(L)) return cgetg(1,tx);
y = new_chunk(lx);
l = lgefint(L)-1; ix = iy = 1;
maxj = BITS_IN_LONG - bfffo(*int_MSW(L));
if ((l-2) * BITS_IN_LONG + maxj >= lx)
pari_err_TYPE("vecextract [mask too large]", L);
for (k = 2, Ld = int_LSW(L); k < l; k++, Ld = int_nextW(Ld))
{
ulong B = *Ld;
for (j = 0; j < BITS_IN_LONG; j++, B >>= 1, ix++)
if (B & 1) y[iy++] = x[ix];
}
{ /* k = l */
ulong B = *Ld;
for (j = 0; j < maxj; j++, B >>= 1, ix++)
if (B & 1) y[iy++] = x[ix];
}
y[0] = evaltyp(tx) | evallg(iy);
return y;
}
/* return a bound for T_2(P), P | polbase
* max |b_i|^2 <= 3^{3/2 + d} / (4 \pi d) [P]_2,
* where [P]_2 is Bombieri's 2-norm
* Sum over conjugates
*/
static GEN
nf_Beauzamy_bound(GEN nf, GEN polbase)
{
GEN lt,C,run,s, G = gmael(nf,5,2), POL, bin;
long i,prec,precnf, d = degpol(polbase), n = degpol(nf[1]);
precnf = gprecision(G);
prec = MEDDEFAULTPREC;
bin = vecbinome(d);
POL = polbase + 2;
/* compute [POL]_2 */
for (;;)
{
run= real_1(prec);
s = real_0(prec);
for (i=0; i<=d; i++)
{
GEN p1 = gnorml2(arch_for_T2(G, gmul(run, gel(POL,i)))); /* T2(POL[i]) */
if (!signe(p1)) continue;
if (lg(p1) == 3) break;
/* s += T2(POL[i]) / binomial(d,i) */
s = addrr(s, gdiv(p1, gel(bin,i+1)));
}
if (i > d) break;
prec = (prec<<1)-2;
if (prec > precnf)
{
nffp_t F; remake_GM(nf, &F, prec); G = F.G;
if (DEBUGLEVEL>1) pari_warn(warnprec, "nf_factor_bound", prec);
}
}
lt = leading_term(polbase);
s = gmul(s, mulis(sqri(lt), n));
C = powrshalf(stor(3,DEFAULTPREC), 3 + 2*d); /* 3^{3/2 + d} */
return gdiv(gmul(C, s), gmulsg(d, mppi(DEFAULTPREC)));
}
static int
extract_selector_ok(long lx, GEN L)
{
long i, l;
switch (typ(L))
{
case t_INT: {
long maxj;
if (!signe(L)) return 1;
l = lgefint(L)-1;
maxj = BITS_IN_LONG - bfffo(*int_MSW(L));
return ((l-2) * BITS_IN_LONG + maxj < lx);
}
case t_STR: {
long first, last, cmpl;
return get_range(GSTR(L), &first, &last, &cmpl, lx);
}
case t_VEC: case t_COL:
l = lg(L);
for (i=1; i<l; i++)
{
long j = itos(gel(L,i));
if (j>=lx || j<=0) return 0;
}
return 1;
case t_VECSMALL:
l = lg(L);
for (i=1; i<l; i++)
{
long j = L[i];
if (j>=lx || j<=0) return 0;
}
return 1;
}
return 0;
}
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;
}
GEN
addsr(long x, GEN y) { return addsr_sign(x, y, signe(y)); }
GEN
subsr(long x, GEN y) { return addsr_sign(x, y, -signe(y)); }
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
bezout(GEN a, GEN b, GEN *pu, GEN *pv)
{
GEN t,u,u1,v,v1,d,d1,q,r;
GEN *pt;
pari_sp av, av1;
long s, sa, sb;
ulong g;
ulong xu,xu1,xv,xv1; /* Lehmer stage recurrence matrix */
int lhmres; /* Lehmer stage return value */
s = abscmpii(a,b);
if (s < 0)
{
t=b; b=a; a=t;
pt=pu; pu=pv; pv=pt;
}
/* now |a| >= |b| */
sa = signe(a); sb = signe(b);
if (!sb)
{
if (pv) *pv = gen_0;
switch(sa)
{
case 0: if (pu) *pu = gen_0; return gen_0;
case 1: if (pu) *pu = gen_1; return icopy(a);
case -1: if (pu) *pu = gen_m1; return(negi(a));
}
}
if (s == 0) /* |a| == |b| != 0 */
{
if (pu) *pu = gen_0;
if (sb > 0)
{ if (pv) *pv = gen_1; return icopy(b); }
else
{ if (pv) *pv = gen_m1; return(negi(b)); }
}
/* now |a| > |b| > 0 */
if (lgefint(a) == 3) /* single-word affair */
{
g = xxgcduu(uel(a,2), uel(b,2), 0, &xu, &xu1, &xv, &xv1, &s);
sa = s > 0 ? sa : -sa;
sb = s > 0 ? -sb : sb;
if (pu)
{
if (xu == 0) *pu = gen_0; /* can happen when b divides a */
else if (xu == 1) *pu = sa < 0 ? gen_m1 : gen_1;
else if (xu == 2) *pu = sa < 0 ? gen_m2 : gen_2;
else
{
*pu = cgeti(3);
(*pu)[1] = evalsigne(sa)|evallgefint(3);
(*pu)[2] = xu;
}
}
if (pv)
{
if (xv == 1) *pv = sb < 0 ? gen_m1 : gen_1;
else if (xv == 2) *pv = sb < 0 ? gen_m2 : gen_2;
else
{
*pv = cgeti(3);
(*pv)[1] = evalsigne(sb)|evallgefint(3);
(*pv)[2] = xv;
}
}
if (g == 1) return gen_1;
else if (g == 2) return gen_2;
else return utoipos(g);
}
/* general case */
av = avma;
(void)new_chunk(lgefint(b) + (lgefint(a)<<1)); /* room for u,v,gcd */
/* if a is significantly larger than b, calling lgcdii() is not the best
* way to start -- reduce a mod b first
*/
if (lgefint(a) > lgefint(b))
{
d = absi(b), q = dvmdii(absi(a), d, &d1);
if (!signe(d1)) /* a == qb */
{
avma = av;
if (pu) *pu = gen_0;
if (pv) *pv = sb < 0 ? gen_m1 : gen_1;
return (icopy(d));
}
else
{
u = gen_0;
u1 = v = gen_1;
v1 = negi(q);
}
/* if this results in lgefint(d) == 3, will fall past main loop */
}
else
{
d = absi(a); d1 = absi(b);
u = v1 = gen_1; u1 = v = gen_0;
}
av1 = avma;
/* main loop is almost identical to that of invmod() */
while (lgefint(d) > 3 && signe(d1))
{
lhmres = lgcdii((ulong *)d, (ulong *)d1, &xu, &xu1, &xv, &xv1, ULONG_MAX);
if (lhmres != 0) /* check progress */
{ /* apply matrix */
if ((lhmres == 1) || (lhmres == -1))
{
if (xv1 == 1)
{
r = subii(d,d1); d=d1; d1=r;
a = subii(u,u1); u=u1; u1=a;
a = subii(v,v1); v=v1; v1=a;
}
else
{
r = subii(d, mului(xv1,d1)); d=d1; d1=r;
a = subii(u, mului(xv1,u1)); u=u1; u1=a;
a = subii(v, mului(xv1,v1)); v=v1; v1=a;
}
}
else
{
r = subii(muliu(d,xu), muliu(d1,xv));
d1 = subii(muliu(d,xu1), muliu(d1,xv1)); d = r;
a = subii(muliu(u,xu), muliu(u1,xv));
u1 = subii(muliu(u,xu1), muliu(u1,xv1)); u = a;
a = subii(muliu(v,xu), muliu(v1,xv));
v1 = subii(muliu(v,xu1), muliu(v1,xv1)); v = a;
if (lhmres&1) { togglesign(d); togglesign(u); togglesign(v); }
else { togglesign(d1); togglesign(u1); togglesign(v1); }
}
}
if (lhmres <= 0 && signe(d1))
{
q = dvmdii(d,d1,&r);
a = subii(u,mulii(q,u1));
u=u1; u1=a;
a = subii(v,mulii(q,v1));
v=v1; v1=a;
d=d1; d1=r;
}
if (gc_needed(av,1))
{
if(DEBUGMEM>1) pari_warn(warnmem,"bezout");
gerepileall(av1,6, &d,&d1,&u,&u1,&v,&v1);
}
} /* 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(uel(d,2), uel(d1,2), 0, &xu, &xu1, &xv, &xv1, &s);
u = subii(muliu(u,xu), muliu(u1, xv));
v = subii(muliu(v,xu), muliu(v1, xv));
if (s < 0) { sa = -sa; sb = -sb; }
avma = av;
if (pu) *pu = sa < 0 ? negi(u) : icopy(u);
if (pv) *pv = sb < 0 ? negi(v) : icopy(v);
if (g == 1) return gen_1;
else if (g == 2) return gen_2;
else return utoipos(g);
}
/* get here when the final sprint was skipped (d1 was zero already).
* Now the matrix is final, and d contains the gcd.
*/
avma = av;
if (pu) *pu = sa < 0 ? negi(u) : icopy(u);
if (pv) *pv = sb < 0 ? negi(v) : icopy(v);
return icopy(d);
}
/* Naive recombination of modular factors: combine up to maxK modular
* factors, degree <= klim and divisible by hint
*
* target = polynomial we want to factor
* famod = array of modular factors. Product should be congruent to
* target/lc(target) modulo p^a
* For true factors: S1,S2 <= p^b, with b <= a and p^(b-a) < 2^31 */
static GEN
nfcmbf(nfcmbf_t *T, GEN p, long a, long maxK, long klim)
{
GEN pol = T->pol, nf = T->nf, famod = T->fact, dn = T->dn;
GEN bound = T->bound;
GEN nfpol = gel(nf,1);
long K = 1, cnt = 1, i,j,k, curdeg, lfamod = lg(famod)-1, dnf = degpol(nfpol);
GEN res = cgetg(3, t_VEC);
pari_sp av0 = avma;
GEN pk = gpowgs(p,a), pks2 = shifti(pk,-1);
GEN ind = cgetg(lfamod+1, t_VECSMALL);
GEN degpol = cgetg(lfamod+1, t_VECSMALL);
GEN degsofar = cgetg(lfamod+1, t_VECSMALL);
GEN listmod = cgetg(lfamod+1, t_COL);
GEN fa = cgetg(lfamod+1, t_COL);
GEN lc = absi(leading_term(pol)), lt = is_pm1(lc)? NULL: lc;
GEN C2ltpol, C = T->L->topowden, Tpk = T->L->Tpk;
GEN Clt = mul_content(C, lt);
GEN C2lt = mul_content(C,Clt);
const double Bhigh = get_Bhigh(lfamod, dnf);
trace_data _T1, _T2, *T1, *T2;
pari_timer ti;
TIMERstart(&ti);
if (maxK < 0) maxK = lfamod-1;
C2ltpol = C2lt? gmul(C2lt,pol): pol;
{
GEN q = ceil_safe(sqrtr(T->BS_2));
GEN t1,t2, ltdn, lt2dn;
GEN trace1 = cgetg(lfamod+1, t_MAT);
GEN trace2 = cgetg(lfamod+1, t_MAT);
ltdn = mul_content(lt, dn);
lt2dn= mul_content(ltdn, lt);
for (i=1; i <= lfamod; i++)
{
pari_sp av = avma;
GEN P = gel(famod,i);
long d = degpol(P);
degpol[i] = d; P += 2;
t1 = gel(P,d-1);/* = - S_1 */
t2 = gsqr(t1);
if (d > 1) t2 = gsub(t2, gmul2n(gel(P,d-2), 1));
/* t2 = S_2 Newton sum */
t2 = typ(t2)!=t_INT? FpX_rem(t2, Tpk, pk): modii(t2, pk);
if (lt)
{
if (typ(t2)!=t_INT) {
t1 = FpX_red(gmul(ltdn, t1), pk);
t2 = FpX_red(gmul(lt2dn,t2), pk);
} else {
t1 = remii(mulii(ltdn, t1), pk);
t2 = remii(mulii(lt2dn,t2), pk);
}
}
gel(trace1,i) = gclone( nf_bestlift(t1, NULL, T->L) );
gel(trace2,i) = gclone( nf_bestlift(t2, NULL, T->L) ); avma = av;
}
T1 = init_trace(&_T1, trace1, T->L, q);
T2 = init_trace(&_T2, trace2, T->L, q);
for (i=1; i <= lfamod; i++) {
gunclone(gel(trace1,i));
gunclone(gel(trace2,i));
}
}
degsofar[0] = 0; /* sentinel */
/* ind runs through strictly increasing sequences of length K,
* 1 <= ind[i] <= lfamod */
nextK:
if (K > maxK || 2*K > lfamod) goto END;
if (DEBUGLEVEL > 3)
fprintferr("\n### K = %d, %Z combinations\n", K,binomial(utoipos(lfamod), K));
setlg(ind, K+1); ind[1] = 1;
i = 1; curdeg = degpol[ind[1]];
for(;;)
{ /* try all combinations of K factors */
for (j = i; j < K; j++)
{
degsofar[j] = curdeg;
ind[j+1] = ind[j]+1; curdeg += degpol[ind[j+1]];
}
if (curdeg <= klim && curdeg % T->hint == 0) /* trial divide */
{
GEN t, y, q, list;
pari_sp av;
av = avma;
/* d - 1 test */
if (T1)
{
t = get_trace(ind, T1);
if (rtodbl(QuickNormL2(t,DEFAULTPREC)) > Bhigh)
{
if (DEBUGLEVEL>6) fprintferr(".");
avma = av; goto NEXT;
}
}
/* d - 2 test */
if (T2)
{
t = get_trace(ind, T2);
if (rtodbl(QuickNormL2(t,DEFAULTPREC)) > Bhigh)
{
if (DEBUGLEVEL>3) fprintferr("|");
avma = av; goto NEXT;
}
}
avma = av;
y = lt; /* full computation */
for (i=1; i<=K; i++)
{
GEN q = gel(famod, ind[i]);
if (y) q = gmul(y, q);
y = FqX_centermod(q, Tpk, pk, pks2);
}
y = nf_pol_lift(y, bound, T);
if (!y)
{
if (DEBUGLEVEL>3) fprintferr("@");
avma = av; goto NEXT;
}
/* try out the new combination: y is the candidate factor */
q = RgXQX_divrem(C2ltpol, y, nfpol, ONLY_DIVIDES);
if (!q)
{
if (DEBUGLEVEL>3) fprintferr("*");
avma = av; goto NEXT;
}
/* found a factor */
list = cgetg(K+1, t_VEC);
gel(listmod,cnt) = list;
for (i=1; i<=K; i++) list[i] = famod[ind[i]];
y = Q_primpart(y);
gel(fa,cnt++) = QXQX_normalize(y, nfpol);
/* fix up pol */
pol = q;
for (i=j=k=1; i <= lfamod; i++)
{ /* remove used factors */
if (j <= K && i == ind[j]) j++;
else
{
famod[k] = famod[i];
update_trace(T1, k, i);
update_trace(T2, k, i);
degpol[k] = degpol[i]; k++;
}
}
lfamod -= K;
if (lfamod < 2*K) goto END;
i = 1; curdeg = degpol[ind[1]];
if (C2lt) pol = Q_primpart(pol);
if (lt) lt = absi(leading_term(pol));
Clt = mul_content(C, lt);
C2lt = mul_content(C,Clt);
C2ltpol = C2lt? gmul(C2lt,pol): pol;
if (DEBUGLEVEL > 2)
{
fprintferr("\n"); msgTIMER(&ti, "to find factor %Z",y);
fprintferr("remaining modular factor(s): %ld\n", lfamod);
}
continue;
}
NEXT:
for (i = K+1;;)
{
if (--i == 0) { K++; goto nextK; }
if (++ind[i] <= lfamod - K + i)
{
curdeg = degsofar[i-1] + degpol[ind[i]];
if (curdeg <= klim) break;
}
}
}
END:
if (degpol(pol) > 0)
{ /* leftover factor */
if (signe(leading_term(pol)) < 0) pol = gneg_i(pol);
if (C2lt && lfamod < 2*K) pol = QXQX_normalize(Q_primpart(pol), nfpol);
setlg(famod, lfamod+1);
gel(listmod,cnt) = shallowcopy(famod);
gel(fa,cnt++) = pol;
}
if (DEBUGLEVEL>6) fprintferr("\n");
if (cnt == 2) {
avma = av0;
gel(res,1) = mkvec(T->pol);
gel(res,2) = mkvec(T->fact);
}
else
{
setlg(listmod, cnt); setlg(fa, cnt);
gel(res,1) = fa;
gel(res,2) = listmod;
res = gerepilecopy(av0, res);
}
return res;
}
