/***********************************************************************/
/***********************************************************************/
/**                                                                   **/
/**               ARITHMETIC OPERATIONS ON POLYNOMIALS                **/
/**                         (second part)                             **/
/**                                                                   **/
/**                        copyright Babe Cool                        **/
/**                                                                   **/
/***********************************************************************/
/***********************************************************************/
/* $Id: polarit2.c,v 2.0.0.2 1997/12/14 20:11:49 karim Exp karim $ */
#include "genpari.h"

GEN
polsym(GEN x, long n)
{
  long av1,av2,dx=lgef(x)-3,i,k;
  GEN s,y,x_lead;

  if (n<0) err(impl,"polsym of a negative n");
  if (typ(x) != t_POL) err(typeer,"polsym");
  if (!signe(x)) err(zeropoler,"polsym");
  y=cgetg(n+2,t_COL); y[1]=lstoi(dx);
  x_lead=(GEN)x[dx+2]; if (gcmp1(x_lead)) x_lead=NULL;
  for (k=1; k<=n; k++)
  {
    av1=avma; s = (dx>=k)? gmulsg(k,(GEN)x[dx+2-k]): gzero;
    for (i=1; i<k && i<=dx; i++)
      s = gadd(s,gmul((GEN)y[k-i+1],(GEN)x[dx+2-i]));
    if (x_lead) s = gdiv(s,x_lead);
    av2=avma; y[k+1]=lpile(av1,av2,gneg(s));
  }
  return y;
}

/* for internal use */
GEN
centermod(GEN x, GEN p)
{
  long av,i,lx;
  GEN y,p1,ps2;

  ps2=shifti(p,-1);
  switch(typ(x))
  {
    case t_INT:
      y=modii(x,p);
      if (cmpii(y,ps2)>0) return subii(y,p);
      return y;

    case t_POL: lx=lgef(x);
      y=cgetg(lx,t_POL); y[1]=x[1];
      for (i=2; i<lx; i++)
      {
	av=avma; p1=modii((GEN)x[i],p);
	if (cmpii(p1,ps2)>0) p1=subii(p1,p);
	y[i]=lpileupto(av,p1);
      }
      return y;

    case t_COL: lx=lg(x);
      y=cgetg(lx,t_COL);
      for (i=1; i<lx; i++)
      {
	p1=modii((GEN)x[i],p);
	if (cmpii(p1,ps2)>0) p1=subii(p1,p);
	y[i]=(long)p1;
      }
      return y;
  }
  return x;
}

static GEN
decpol(GEN x, long klim)
{
  short int pos[200];
  long av=avma,av1,tete,k,kin,i,j,i1,i2,fl,d,nbfact;
  GEN res,p1,p2;

  kin=1; res=cgetg(lgef(x)-2,t_VEC); nbfact=0;
  p1=roots(x,DEFAULTPREC); d=lg(p1)-1; if (!klim) klim=d;
  do
  {
    fl=1;
    for (k=kin; k+k <= d && k<=klim; k++)
    {
      for (i=0; i<=k; i++) pos[i]=i;
      do
      {
	av1=avma; p2=gzero; j=0;
	for (i1=1; i1<=k; i1++) p2=gadd(p2,(GEN)p1[pos[i1]]);
	if (gexpo(gimag(p2))<-20 && gexpo(gsub(p2,ground(p2)))<-20)
	{
	  p2=gun;
	  for (i1=1; i1<=k; i1++)
	    p2=gmul(p2,gsub(polx[0],(GEN)p1[pos[i1]]));
          p2 = ground(p2);
	  if (gcmp0(gimag(p2)) && gcmp0(gmod(x,p2)))
	  {
	    res[++nbfact]=(long)p2; x=gdiv(x,p2);
            kin=k; p2=cgetg(d-k+1,t_COL);
            for (i=i1=i2=1; i<=d; i++)
	    {
	      if (i1<=k && i==pos[i1]) i1++;
	      else p2[i2++]=p1[i];
	    }
	    p1=p2; d-=k; fl=0; break;
	  }
	}
	avma=av1; pos[k]++;
	while (pos[k-j] > d-j) { j++; pos[k-j]++; }
	for (i=k-j+1; i<=k; i++) pos[i]=i+pos[k-j]-k+j;
      }
      while (j<k);
      if (!fl) break;
    }
    if (lgef(x)<=3) break;
  }
  while (!fl || (k+k <= d && k<=klim));
  if (lgef(x)>3) res[++nbfact]=(long)x;
  setlg(res,nbfact+1); tete=avma;
  return gerepile(av,tete,greal(res));
}

/* This code was kindly written for us by Richard Schroeppel */

/* Note that PARI's idea of the maximum possible coefficient involves the
 * limit on the degree (klim).  Consider revising this.  If I don't respect
 * the degree limit when testing potential factors, there's the possibility
 * that I might identify a high degree factor that isn't irreducible, because
 * it's lower degree divisors were missed because they had a coefficient
 * outside the Borne limit for klim, but the higher degree factor had it's
 * coefficients within Borne.  This would still have the property that any
 * factors of degree <= klim were guaranteed irr, but higher degrees
 * (> 2*klim) might not be irr.
 *
 * The subroutine:
 *  fxn points at the first unconsidered factor for the current combination
 *  psf is the product-so-far, or 0 for a null product
 *  dlim is the degree limit remaining for unconsidered divisors
 *  other arguments are "global" and must already be setup
 *  as factors are found, they are put in cmbf_fax; the count is kept in
 *  cmbf_faxn; and they are divided out of cmbf_target; the degree and
 *  leading coefficient are updated; and the constituent modular factors
 *  are deleted from cmbf_modfax.
 *  exit value is 1 if any factors are found.
 *  If psf is 0, all factors made up from pieces at or after fxn will be
 *  found & removed.  If psf is not 0, only the factor which is a
 *  continuation of psf will be found.
 */
/* setup for calling cmbf = combine_factors */
static GEN cmbf_target;      /* target poly. Assume content removed */
static GEN cmbf_lc;          /* leading coefficient */
static GEN cmbf_abslc;       /* |lc| */
static GEN cmbf_abslcxtarget;/* abslc * target */
static GEN cmbf_mod;         /* modulus */
static GEN cmbf_fax;         /* result array + one cell for leftover cst. */
static GEN cmbf_modfax; /* array of modular factors.  Each has LC 1.1 based
                           indexing. Product should be congruent to a/lc(a). */
static long cmbf_degree;     /* degree(target) */
static long cmbf_modfaxn;    /* number of modular factors */
static long cmbf_faxn;       /* last used cell in fax. # of factors found */

static int
cmbf(long fxn, GEN psf, long dlim, long hint)
{
  long newd,ltop,val=0, val2=0; /* assume failure */
  GEN newf,newpsf,quo,rem,cont;

  if (dlim <= 0 || fxn > cmbf_modfaxn) return 0;

  /* first, try deeper factors without considering the current one */
  if (fxn < cmbf_modfaxn)
  { 
    val = cmbf(fxn+1,psf,dlim,hint);
    if (val && psf) return val;
  }

  /* second, try including the current modular factor in the product */
  newf = (GEN)cmbf_modfax[fxn];
  if (!newf) return val; /* modular factor already used */

  newd = lgef(newf)-3; if (newd > dlim) return val;
  if (!(newd%hint))
  {
    if (!psf) psf = cmbf_abslc;
    newpsf = centermod(gmul(psf,newf),cmbf_mod);

    ltop=avma;	/* try out the new combination */
    quo = poldivres(cmbf_abslcxtarget,newpsf,&rem);
    if (!signe(rem))  
    {
      /* found a factor */
      cont = content(newpsf); 
      if (signe(leading_term(newpsf)) < 0) cont = negi(cont);
      newpsf = gdiv(newpsf,cont);
      cmbf_fax[++cmbf_faxn] = (long)newpsf; /* store factor */
      cmbf_modfax[fxn] = 0; /* remove used modular factor */
      /* fix up target */
      cmbf_target = gdiv(quo,leading_term(newpsf));
      cmbf_degree = lgef(cmbf_target)-3;
      cmbf_lc = (GEN)cmbf_target[cmbf_degree+2];
      cmbf_abslc = absi(cmbf_lc);
      cmbf_abslcxtarget = gmul(cmbf_abslc,cmbf_target);
      return 1;
    }
    avma=ltop;
  }
  /* newpsf needs more; try for it */
  if (newd == dlim) return val; /* no more room in degree limit */
  if (fxn == cmbf_modfaxn) return val; /* no more modular factors to try */
  val2 = cmbf(fxn+1,newpsf,dlim-newd,hint);
  if (val2) cmbf_modfax[fxn] = 0; /* remove used modular factor */
  return val||val2;
}

static long
get_d0(long jmax,ulong tabbit[])
{
  long j,k=1,j1=2;

  for (j=jmax; j>=0; j--)
  {
    for (  ; k<=15; k++)
    {
      if (tabbit[j]&j1) return ((jmax-j)<<4)+k;
      j1<<=1;
    } 
    k=0; j1=1;
  }
  return (jmax<<4)+15;
}

static void
dotab(long d,long lbit,ulong tablbit[],ulong tabkbit[])
{
  ulong rem,pro;
  long j,d1,d2;

  d1=d>>4; d2=d&15; rem=0;
  for (j=0; j<d1; j++) tablbit[lbit-1-j]=0;
  for (   ; j<lbit; j++)
  {
    pro = tabkbit[lbit-1-j+d1]<<d2;
    tablbit[lbit-1-j] = (pro&0xffff)+rem; rem=pro>>16;
  }
  for (j=0; j<lbit; j++) tabkbit[j] |= tablbit[j];
}

#define NOMBDEP 5
static GEN
squff(GEN a, long klim, long hint)
{
  GEN p1,p2,y,g,pe,pg,s,t,u,v,w,xmod,unmod,polxmodp,ae,be,aprov,pev;
  GEN pe2,unmodpe,unmodpe2;
  GEN tabd[NOMBDEP][500],unmodp[NOMBDEP];
  GEN *gptr[6];
  ulong tabbit[60],tabkbit[60],tablbit[60];
  long av=avma,tetpil,p,tabp[NOMBDEP],nfacp[NOMBDEP];
  long va=varn(a),da=lgef(a)-3,lbit,d0,i,j,d,e;
  long np,nmax,imax,kd,lgg,nf,ev,nfd,nft,ltop,lbot,lim;
  byteptr pt=diffptr;

  if (hint < 0) return decpol(a,klim);
  np=0; lbit=(da>>4)+1; nmax=da+1; imax=0; kd=da>>1;
  if (!klim || klim>kd) klim=kd;
  p = 0;
  while (np<NOMBDEP)
  {
    p += *pt++; if (!*pt) err(primer1);
    unmodp[np] = gmodulss(1,p);
    if (!gcmp0(discsr(gmul(a,unmodp[np]))) && smodis((GEN)a[da+2],p))
    {
      tabp[np]=p; np++;
    }
  }
  for (i=0; i<NOMBDEP; i++)
  {
    p=tabp[i]; nfacp[i]=0; unmod=unmodp[i];
    tabkbit[lbit-1]=1; for (j=0; j<lbit-1; j++) tabkbit[j]=0;
    polxmodp = gmul(unmod,polx[va]);
    v = gmul(unmod,a); d=0;
    w = xmod = gmodulcp(polxmodp,v);
    while(d<(e=(lgef(v)-3))>>1)
    {
      d++; w=gpuigs(w,p);
      p1=(GEN)gsub(w,xmod)[2]; g=ggcd(p1,v);
      tabd[i][d]=g; lgg=lgef(g)-3;
      if (lgg>0)
      {
	v=gdiv(v,g); w=gmodulcp(gmod((GEN)w[2],v),v);
	xmod=gmodulcp(polxmodp,v);
	nfacp[i] += (lgg/d);
	for (kd=d; kd<=lgg; kd+=d) dotab(d,lbit,tablbit,tabkbit);
      }
    }
    if (e>0)
    {
      tabd[i][e]=v; nfacp[i]++;
      dotab(e,lbit,tablbit,tabkbit);
    }
    if (nfacp[i]<nmax) { nmax=nfacp[i]; imax=i; }
    for (j=d+1; j<e; j++) tabd[i][j]=polun[va];
    if (i)
      for (j=0; j<lbit; j++) tabbit[j] &= tabkbit[j];
    else
      for (j=0; j<lbit; j++) tabbit[j] = tabkbit[j];
    d0 = get_d0(lbit-1,tabbit);
    if (d0==da || d0>klim)
    {
      tetpil=avma; y=cgetg(2,t_COL); y[1]=lcopy(a);
      return gerepile(av,tetpil,y);
    }
  }
  p1=gzero; for (i=2; i<=da+2; i++) p1=addii(p1,sqri((GEN)a[i]));
  p2=absi((GEN)a[da+2]);
  p1=addii(p2,addsi(1,racine(p1)));
  p1=mulii(p1,binome(stoi(da-1),klim));
  p1=shifti(mulii(p2,p1),1);
  p=tabp[imax]; pg=stoi(p);
  e=itos(gceil(divrr(glog(p1,DEFAULTPREC), glog(pg,DEFAULTPREC))));
  pev=gpuigs(pg,e); nf=nfacp[imax]; nft=0;
  y=cgetg(nf+1,t_COL); p1=cgetg(nf+1,t_COL);
  for (d=1; nft<nf; d++)
  {
    g=tabd[imax][d]; g=gdiv(g,leading_term(g)); lgg=lgef(g)-3;
    if (lgg)
    {
      nfd=lgg/d; p1[nft+1]=(long)g;
      split(p,(GEN*)(p1+nft+1),d,p,shifti(gpuigs(pg,d),-1));
      nft += nfd;
    }
  }
  /* do a Hensel lift */
  aprov=a; ltop=avma; lim=(ltop+bot)>>1;
  for (i=1; i<=nf-1; i++)
  {
    pe=pg; pe2=sqri(pe); ev=1; p2=(GEN)p1[i];
    unmodpe=gmodulsg(1,pe); unmodpe2=gmodulsg(1,pe2);
    ae=gdiv(p2,leading_term(p2)); be=gdiv(aprov,ae);
    g = bezoutpol(ae,be,&u,&v);
    if (isnonscalar(g)) err(bugparier,"Hensel lift (squff)");

    u=gdiv(u,(GEN)g[2]); v=gdiv(v,(GEN)g[2]);
    for (j=2; j<lgef(ae); j++) mael(ae,j,1)=(long)pe2;
    for (j=2; j<lgef(be); j++) mael(be,j,1)=(long)pe2;
    for (j=2; j<lgef( u); j++) mael(u,j,1)=(long)pe2;
    for (j=2; j<lgef( v); j++) mael(v,j,1)=(long)pe2;
    for(;;)
    {
      g=gmul(gdiv(lift_intern(gsub(aprov,gmul(ae,be))),pe),unmodpe);
      t=poldivres(gmul(v,g),ae,&s);
      t=gadd(gmul(u,g),gmul(t,be));
      g=gmul(pe,lift_intern(s)); ae=gadd(ae,g); 
      s=gmul(pe,lift_intern(t)); be=gadd(be,s);
      g=lift_intern(gsub(gun,gadd(gmul(u,ae),gmul(v,be))));
      g=gmul(gdiv(g,pe),unmodpe);
      t=poldivres(gmul(v,g),ae,&s);
      t=gadd(gmul(u,g),gmul(t,be));
      s=gmul(pe,lift_intern(s)); v=gadd(v,s);
      t=gmul(pe,lift_intern(t)); u=gadd(u,t);
      pe=pe2; ev<<=1; if (ev>=e) break;

      ae=lift_intern(ae); u=lift_intern(u);
      be=lift_intern(be); v=lift_intern(v); lbot=avma;
      pe2=sqri(pe); unmodpe=unmodpe2; unmodpe2=gmodulsg(1,pe2);
      ae=gmul(ae,unmodpe2); u=gmul(u,unmodpe2);
      be=gmul(be,unmodpe2); v=gmul(v,unmodpe2);
      if (low_stack(lim, (ltop+bot)>>1))
      {
        if(DEBUGMEM>1) err(warnmem,"[1]: squff");
        p1=gcopy(p1); aprov=gcopy(aprov);
        gptr[0]=&p1; gptr[1]=&ae; gptr[2]=&be; gptr[3]=&aprov;
        gptr[4]=&u; gptr[5]=&v; gerepilemanysp(ltop,lbot,gptr,6);
        pe=gpuigs(pg,ev); pe2=sqri(pe);
        unmodpe=gmodulsg(1,pe); unmodpe2=gmodulsg(1,pe2);
      }
    }
    lbot=avma; be=lift(be); ae=lift(ae); p1[i]=(long)ae;
    if (i<nf-1) aprov=gdeuc(aprov,ae);
    if (low_stack(lim, (ltop+bot)>>1))
    {
      if(DEBUGMEM>1) err(warnmem,"[2]: squff");
      p1=gcopy(p1); if (i>=nf-1) aprov=gcopy(aprov);
      gptr[0]=&p1; gptr[1]=&ae; gptr[2]=&be; gptr[3]=&aprov;
      gerepilemanysp(ltop,lbot,gptr,4);
    }
  }
  be = gmul(be,mpinvmod(leading_term(be),pev));
  p1[nf]=(long)centermod(be,pev);
  for (i=1; i<=nf; i++)
    if (!gcmp1(leading_term(p1[i]))) err(bugparier,"factpol (squff)");

  cmbf_target = a;
  cmbf_degree = lgef(a)-3;
  cmbf_lc = (GEN)a[lgef(a)-1];
  cmbf_abslc = absi(cmbf_lc);
  cmbf_abslcxtarget = gmul(cmbf_abslc,a);
  cmbf_mod = pev;
  cmbf_modfax = p1;
  cmbf_modfaxn = nf;
  cmbf_fax = cgetg(nf+2,t_COL);
  cmbf_faxn = 0;
  /* sorting factors decreasing by degree helps if klim is used
   * If not, can start with first arg of 2 instead of 1, saving some time.
   * Should be sending tabbit through for more efficiency ??? 
   */
  cmbf(1,NULL,klim,hint); /* The call */

  if (signe(cmbf_lc)<0) cmbf_target = gneg(cmbf_target);
  if (cmbf_degree)
    cmbf_fax[++cmbf_faxn] = (long)cmbf_target; /* leftover factor */
  tetpil=avma; y=cgetg(cmbf_faxn+1,t_COL);
  for (i=1; i<=cmbf_faxn; i++) y[i]=lcopy((GEN)cmbf_fax[i]);
  return gerepile(av,tetpil,y);
}

/* klim=0 habituellement, sauf si l'on ne veut chercher que les facteurs
 * de degre <= klim
 */
GEN
factpol(GEN x, long klim, long hint)
{
  long av=avma,av2,lx,vv,k,i,j,i1,f,nbfac;
  GEN res,fa,p1,p2,y,d,xp,t,v,w;

  if (typ(x)!=t_POL) err(notpoler,"factpol");
  if (!signe(x)) err(zeropoler,"factpol");
  y=cgetg(3,t_MAT); lx=lgef(x);
  if (lx==3) { y[1]=lgetg(1,t_COL); y[2]=lgetg(1,t_COL); return y; }
  if (lx==4)
  {
    p1 = leading_term(x); x = gcmp1(p1)? gcopy(x): gdiv(x,p1);
    p1=cgetg(2,t_COL); y[1]=(long)p1; p1[1]=(long)x;
    p1=cgetg(2,t_COL); y[2]=(long)p1; p1[1]=un; return y;
  }

  p1 = cgetg(1,t_VEC); fa=cgetg(lx,t_VEC);
  for (i=1; i<lx; i++) fa[i] = (long)p1;
  d=content(x);
  if (!gcmp1(leading_term(x))) d = negi(d);
  if (!gcmp1(d)) x=gdiv(x,d);
  vv=varn(x); xp=deriv(x,vv); t=ggcd(x,xp);
  v=gdiv(x,t); w=gdiv(xp,t); j=0; f=1; nbfac=0;
  while (f)
  {
    j++; w=gsub(w,deriv(v,vv)); f=signe(w);
    if (f) { res=ggcd(v,w); v=gdiv(v,res); w=gdiv(w,res); }
    else res=v;
    if (lgef(res) > 3)
    {
      fa[j] = (long)squff(res,klim,hint);
      nbfac += lg(fa[j])-1;
    }
  }
  av2=avma; y=cgetg(3,t_MAT);
  p1=cgetg(nbfac+1,t_COL); y[1]=(long)p1;
  p2=cgetg(nbfac+1,t_COL); y[2]=(long)p2;
  for (i=1,k=0; i<=j; i++)
    for (i1=1; i1<lg(fa[i]); i1++)
    {
      k++; p1[k]=lcopy(gmael(fa,i,i1)); p2[k]=lstoi(i);
    }
  return gerepile(av,av2,y);
}

GEN
factpol2(GEN x, long klim)
{
  return factpol(x,klim,-1);
}

/***********************************************************************/
/**                                                                   **/
/**                          FACTORISATION                            **/
/**                                                                   **/
/***********************************************************************/

static long
assign(GEN x, GEN *p)
{
  if (*p==gzero) { *p=x; return 1; }
  return gegal(x,*p);
}

static long
polynomialtype(GEN x, GEN *ptp, GEN * ptpol, long *ptpa)
{
  long t[20]; /* code pour 0,1,2,3,61,62,63,67,7,81,82,83,86,87,91,93,97 */
  long tx = typ(x),lx,i,j,f=1,s,pa=BIGINT,pabis;
  GEN  p=gzero,pol=gzero,pcx,pbis,polbis,p1,p2;

  if (is_scalar_t(tx)) 
  {
    if (tx == t_POLMOD) return 0;
    x = scalarpol(x,0);
  }
  for (i=0; i<=19; i++) t[i]=0;
  pcx=NULL; lx=lgef(x);
  for (i=2; i<lx; i++)
  {
    p1=(GEN)x[i]; tx=typ(p1);
    switch(tx)
    {
      case t_INT: case t_FRAC: case t_FRACN:
        break;
      case t_REAL:
        pa=min(pa,precision(p1)); t[2]=1; break;
      case t_INTMOD:
        t[3]=f=assign((GEN)p1[1],&p); break;
      case t_COMPLEX:
	for (j=1; j<=2; j++)
	{
	  p2=(GEN)p1[j];
	  switch(typ(p2))
	  {
	    case t_INT: case t_FRAC: case t_FRACN:
              if (!pcx) pcx = gaddsg(1,gsqr(polx[0]));
	      t[4]=f=assign(pcx,&pol); break;
	    case t_INTMOD:
	      f=assign((GEN)p2[1],&p);
              if (!pcx) pcx = gaddsg(1,gsqr(polx[0]));
	      if (f) t[6]=f=assign(pcx,&pol); break;
	    case t_REAL:
	      pa=min(pa,precision(p2)); t[5]=1; break;
	    case t_PADIC:
	      f=assign((GEN)p2[2],&p);
              if (!pcx) pcx = gaddsg(1,gsqr(polx[0]));
	      if (f) t[7]=f=assign(pcx,&pol);
	      if (f) pa=min(pa,precp(p2)+valp(p2));
	      break;
	    default: f=0;
	  }
	  if (!f) return 0;
	}
	break;
      case t_PADIC:
        t[8]=f=assign((GEN)p1[2],&p);
	if (f) pa=min(pa,precp(p1)+valp(p1)); 	
	break;
      case t_QUAD:
	for (j=2; j<=3; j++)
	{
	  p2=(GEN)p1[j];
	  switch(typ(p2))
	  {
	    case t_INT: case t_FRAC: case t_FRACN:
	      t[9]=f=assign((GEN)p1[1],&pol); break;
	    case t_INTMOD:
	      f=assign((GEN)p2[1],&p);
	      if (f) t[11]=f=assign((GEN)p1[1],&pol); break;
	    case t_REAL:
	      if (gsigne(discsr((GEN)p1[1]))>0) t[10]=1;
	      else t[12]=1;
	      pa=min(pa,precision(p2)); break;
	    case t_PADIC:
	      f=assign((GEN)p2[2],&p);
	      if (f) t[13]=f=assign((GEN)p1[1],&pol);
	      if (f) pa=min(pa,precp(p2)+valp(p2));
	      break;
	    default: f=0;
	  }
	  if (!f) return 0;
	}
	break;
      case t_POLMOD:
	f=assign((GEN)p1[1],&pol);
	if (!f) return 0;
	pbis=polbis=gzero;
	s=polynomialtype((GEN)p1[1],&pbis,&polbis,&pabis);
	switch(s)
	{
	  case 1: t[14]=1; break;
	  case 3: t[15]=1; break;
          case 7: t[16]=1; if (pabis<pa) pa=pabis; break;
	  default: f=0;
	}
	if (f&&signe(pbis)) f=assign(pbis,&p);
	if (f&&signe(polbis)) f=assign(polbis,&pol);
	if (f)
	{
	  pbis=polbis=gzero;
	  s=polynomialtype((GEN)p1[2],&pbis,&polbis,&pabis);
	  switch(s)
	  {
	    case 1: t[14]=1; break;
	    case 3: t[15]=1; break;
	    case 7: t[16]=1; if (pabis<pa) pa=pabis; break;
	    default: f=0;
	  }
	  if (f&&signe(pbis)) f=assign(pbis,&p);
	  if (f&&signe(polbis)) f=assign(polbis,&pol);
	}
	break;
      default: f=0;
    }
    if (!f) return 0;
  }
  if (t[5]+t[12])
  {
    if (t[3]+t[6]+t[7]+t[8]+t[11]+t[13]+t[14]+t[15]+t[16]) return 0;
    *ptpa=pa; return 6;
  }
  if (t[2]+t[10])
  {
    if (t[3]+t[6]+t[7]+t[8]+t[11]+t[13]+t[14]+t[15]+t[16]) return 0;
    *ptpa=pa; return 2;
  }
  if (t[6]+t[11]+t[15])
  {
    *ptp=p; *ptpol=pol;
    if (t[15]) return 93;
    return t[11]?83:63;
  }
  if (t[7]+t[13]+t[16])
  {
    *ptp=p; *ptpol=pol; *ptpa=pa;
    if (t[16]) return 97;
    return t[13]?87:67;
  }
  if (t[4]+t[9]+t[14])
  {
    *ptpol=pol;
    if (t[14]) return 91;
    return t[9]?81:61;
  }
  if (t[3]) { *ptp=p; return 3; }
  if (t[8]) { *ptp=p; *ptpa=pa; return 7; }
  return 1;
}

GEN
factor0(GEN x,long flag)
{
  long tx=typ(x);

  if (flag<0) return factor(x);
  if (is_matvec_t(tx)) return gboundfact(x,flag);
  if (tx==t_INT || tx==t_FRAC || tx==t_FRACN) return boundfact(x,flag);
  err(talker,"partial factorization is not meaningful here");
  return NULL; /* not reached */
}

GEN
factor(GEN x)
{
  long tx=typ(x),lx,l,tetpil,i,j,pa,v,r1;
  GEN  y,p1,p2,p,p3,p4,p5,pol;

  if (gcmp0(x))
  {
    y=cgetg(3,t_MAT);
    p1=cgetg(2,t_COL); y[1]=(long)p1; p1[1]=zero; 
    p2=cgetg(2,t_COL); y[2]=(long)p2; p2[1]=un;
    return y;
  }
  switch(tx)
  {
    case t_INT:
      return decomp(x);

    case t_FRACN:
      l=avma; x=gred(x); /* fall through */
    case t_FRAC:
      if (tx==t_FRAC) l=avma;
      p1=decomp((GEN)x[1]); p2=decomp((GEN)x[2]);
      p4=concatsp((GEN)p1[1],(GEN)p2[1]);
      p5=concatsp((GEN)p1[2],gneg((GEN)p2[2]));
      p3=indexsort(p4);
      tetpil=avma; y=cgetg(3,t_MAT);
      y[1]=(long)extract(p4,p3);
      y[2]=(long)extract(p5,p3);
      return gerepile(l,tetpil,y);

    case t_POL:
      tx=polynomialtype(x,&p,&pol,&pa);
      switch(tx)
      {
	case 1:
	  return factpol(x,0,1);

	case 3:
	  return factmod(x,p);

	case 6:
	  l=avma;  p1=roots(x,pa);  lx=lg(p1); v=varn(x);
          tetpil=avma; y=cgetg(3,t_MAT);
          p2=cgetg(lx,t_COL); y[1]=(long)p2;
	  p3=cgetg(lx,t_COL); y[2]=(long)p3;
	  for(i=1; i<lx; i++) { p2[i]=lsub(polx[v],(GEN)p1[i]); p3[i]=un; }
	  return gerepile(l,tetpil,y);

	case 2:
	  l=avma; p1=roots(x,pa); r1=0; v=varn(x);
	  for(i=1; i<lg(p1); i++)
            if (gcmp0(gmael(p1,i,2))) r1++; else break;
	  lx=(r1+lg(p1)+1)>>1; p2=cgetg(lx,t_COL);
	  for(i=1; i<=r1; i++) p2[i]=lsub(polx[v],gmael(p1,i,1));
	  for(   ; i<lx; i++)
	  {
	    p3=(GEN)p1[2*i-r1-1];
	    p2[i]=ladd(gnorm(p3),
		       gmul(polx[v],gsub(polx[v],gmul2n((GEN)p3[1],1))));
	  }
	  tetpil=avma; y=cgetg(3,t_MAT); y[1]=lcopy(p2); p3=cgetg(lx,t_COL);
	  for(i=1; i<lx; i++) p3[i]=un; y[2]=(long)p3;
	  return gerepile(l,tetpil,y);

	case 7:
	  return factorpadic4(x,p,pa);

	case 61: case 63: case 67: case 81: case 83: case 87:
	case 91: case 93: case 97:
	  l=avma; lx=lgef(x); p1=cgetg(lx,t_POL);
	  for(i=1; i<lx; i++) p1[i]=x[i]; x=p1;
	  for(i=2; i<lx; i++)
	  {
	    p1=(GEN)x[i];
	    switch(typ(p1))
	    {
	      case t_COMPLEX:
		x[i]=lmodulcp(gadd((GEN)p1[1],
			      gmul((GEN)p1[2],polx[varn(pol)])),pol);
		break;
	      case t_QUAD:
		x[i]=lmodulcp(gadd((GEN)p1[2],
			      gmul((GEN)p1[3],polx[varn(pol)])),pol);
		break;
	    }
	  }
	  switch(tx)
	  {
	    case 61: case 81: case 91:
	      tetpil=avma; p1=polfnf(x,pol); break;
	    case 63: case 83: case 93:
	      tetpil=avma; p1=factmod9(x,p,pol); break;
	    case 67: case 87: case 97:
	      err(impl,"factor of general polynomial"); break;
	  }
	  switch(tx)
	  {
	    case 61: case 63: case 67:
	      p2=(GEN)p1[1];
	      for(i=1; i<lg(p2); i++)
	      {
		p3=(GEN)p2[i];
		for(j=2; j<lgef(p3); j++)
		{
		  p4=(GEN)p3[j];
		  if (typ(p4)==t_POLMOD) p3[j]=lsubst((GEN)p4[2],varn(pol),gi);
		}
	      }
	      tetpil=avma; y=cgetg(3,t_MAT);
	      y[1]=lcopy(p2); y[2]=lcopy((GEN)p1[2]);
	      return gerepile(l,tetpil,y);

	    case 81: case 83: case 87:
	      p2=(GEN)p1[1];
	      p5=cgetg(4,t_QUAD); p5[1]=(long)pol; p5[2]=zero; p5[3]=un;
	      for(i=1; i<lg(p2); i++)
	      {
		p3=(GEN)p2[i];
		for(j=2; j<lgef(p3); j++)
		{
		  p4=(GEN)p3[j];
		  if(typ(p4)==t_POLMOD) p3[j]=lsubst((GEN)p4[2],varn(pol),p5);
		}
	      }
	      tetpil=avma; y=cgetg(3,t_MAT);
	      y[1]=lcopy(p2); y[2]=lcopy((GEN)p1[2]);
	      return gerepile(l,tetpil,y);

	    case 91: case 93: case 97:
	      return gerepile(l,tetpil,p1);
	  }
	  break;
      }
      err(impl,"factor of general polynomial");

    case t_RFRACN:
      l=avma; x=gred_rfrac(x); /* fall through */
    case t_RFRAC:
      if (tx==t_RFRAC) l=avma;
      p1=factor((GEN)x[1]); p2=factor((GEN)x[2]);
      p3=gneg((GEN)p2[2]); tetpil=avma;
      y=cgetg(3,t_MAT); y[1]=lconcat((GEN)p1[1],(GEN)p2[1]);
      y[2]=lconcat((GEN)p1[2],p3);
      return gerepile(l,tetpil,y);

    case t_VEC: case t_COL: case t_MAT:
      l=lg(x); y=cgetg(l,tx);
      for (i=1; i<l; i++) y[i]=(long)factor((GEN)x[i]);
      return y;
  }
  err(impl,"general factorization");
  return NULL; /* not reached */
}

GEN
factorback(GEN fa, GEN nf)
{
  long av=avma,k;
  GEN ex,res;

  if (typ(fa)!=t_MAT || lg(fa)!=3)
    err(talker,"incorrect factorisation in factorback");
  ex=(GEN)fa[2]; fa=(GEN)fa[1]; res=gun;
  if (nf)
    for (k=1; k<lg(fa); k++)
      res = idealmul(nf, res, idealpow(nf, (GEN)fa[k],(GEN)ex[k]));
  else
    for (k=1; k<lg(fa); k++)
      res = gmul(res, gpuigs((GEN)fa[k],itos((GEN)ex[k])));
  return gerepileupto(av,res);
}

GEN
gisirreducible(GEN x)
{
  long av=avma, tx = typ(x),l,i;
  GEN y;

  if (is_matvec_t(tx))
  {
    l=lg(x); y=cgetg(l,tx);
    for (i=1; i<l; i++) y[i]=(long)gisirreducible((GEN)x[i]);
    return y;
  }
  if (is_intreal_t(tx) || is_frac_t(tx)) return gzero;
  if (tx!=t_POL) err(notpoler,"gisirreducible");
  l=lgef(x); if (l<=3) return gzero;
  y=factor(x); avma=av;
  return (lgef(gcoeff(y,1,1))==l)?gun:gzero;
}

/*******************************************************************/
/*                                                                 */
/*                         PGCD GENERAL                            */
/*                                                                 */
/*******************************************************************/

static GEN scalcontent(GEN x);

GEN
gcd0(GEN x, GEN y, long flag)
{
  switch(flag)
  {
    case 0: return ggcd(x,y);
    case 1: return modulargcd(x,y);
    case 2: return srgcd(x,y);
    default: err(flagerr);
  }
  return NULL; /* not reached */
}

GEN
ggcd(GEN x, GEN y)
{
  long l,av,tetpil,i,vx,vy, tx = typ(x), ty = typ(y);
  GEN p1,p2,z;

  if (tx>ty) { p1=x; x=y; y=p1; l=tx; tx=ty; ty=l; }
  if (is_matvec_t(ty))
  { 
    l=lg(y); z=cgetg(l,ty); 
    for (i=1; i<l; i++) z[i]=lgcd(x,(GEN)y[i]);
    return z;
  }
  if (gcmp0(x)) return gcopy(y);
  if (gcmp0(y)) return gcopy(x);
  l=avma;
  if (is_const_t(tx))
  {
    if (is_const_t(ty)) switch(tx)
    {
      case t_INT:
        switch(ty)
        {
          case t_INT:
            return mppgcd(x,y);

          case t_INTMOD:
            z=cgetg(3,t_INTMOD);
            l=avma; p1=mppgcd((GEN)y[1],(GEN)y[2]);
            if (!gcmp1(p1))
              { tetpil=avma; p1=gerepile(l,tetpil,mppgcd(x,p1)); }
            z[2]=(long)p1; z[1]=copyifstack(y[1]);
            return z;

          case t_FRAC: case t_FRACN:
            z=cgetg(3,t_FRAC); z[2]=licopy((GEN)y[2]);
            z[1]=lmppgcd(x,(GEN)y[1]); return gredsp(z);

          case t_PADIC:
            return gpuigs((GEN)y[2],min(valp(y),ggval(x,(GEN)y[2])));

          case t_COMPLEX: case t_QUAD:
            p1=scalcontent(y); tetpil=avma;
            return gerepile(l,tetpil,ggcd(x,p1));

          default: return gun;
        }

      case t_INTMOD:
        switch(ty)
        {
          case t_INTMOD:
            z=cgetg(3,t_INTMOD);
            z[1]=gegal((GEN)x[1],(GEN)y[1]) ? copyifstack(x[1]):
                                              lmppgcd((GEN)x[1],(GEN)y[1]);
            if (gcmp1((GEN)z[1])) z[2]=zero;
            else
            {
              l=avma; p1=mppgcd((GEN)z[1],(GEN)x[2]);
              if (!gcmp1(p1))
              {
                tetpil=avma;
                p1=gerepile(l,tetpil,mppgcd(p1,(GEN)y[2]));
              }
              z[2]=(long)p1;
            } 
            return z;

          case t_FRAC:
            p1=mppgcd((GEN)x[1],(GEN)y[2]);
            if (!gcmp1(p1)) err(gcder1);
            tetpil=avma; return gerepile(l,tetpil,ggcd((GEN)y[1],x));

          case t_FRACN:
            p1=gred(y); tetpil=avma;
            return gerepile(l,tetpil,ggcd(p1,x));

          case t_PADIC:
            return gpuigs((GEN)y[2],min(valp(y),ggval(x,(GEN)y[2])));

          case t_COMPLEX: case t_QUAD:
            p1=scalcontent(y); tetpil=avma;
            return gerepile(l,tetpil,ggcd(x,p1));

          default: return gun;
        }

      case t_FRAC: case t_FRACN:
        switch(ty)
        {
          case t_FRAC: case t_FRACN:
            z=cgetg(3,t_FRAC); z[2]=lmulii((GEN)x[2],(GEN)y[2]); l=avma;
            p1=mulii((GEN)x[1],(GEN)y[2]);
            p2=mulii((GEN)x[2],(GEN)y[1]); tetpil=avma;
            z[1]=lpile(l,tetpil,mppgcd(p1,p2));
            return gredsp(z);

          case t_COMPLEX: case t_QUAD:
            p1=scalcontent(y); tetpil=avma;
            return gerepile(l,tetpil,ggcd(x,p1));

          case t_PADIC:
            return gpuigs((GEN)y[2],min(valp(y),ggval(x,(GEN)y[2])));

          default: return gun;
        }
      case t_COMPLEX:
        switch(ty)
        {
          case t_COMPLEX:
            p1=gdiv(x,y);
            if (gcmp0((GEN)p1[2]))
            {
              tetpil=avma; p1=(GEN)p1[1];
              switch(typ(p1))
              {
                case t_INT:
                  return gerepile(l,tetpil,gcopy(y));
                case t_FRAC: case t_FRACN:
                  return gerepile(l,tetpil,gdiv(y,(GEN)p1[2]));
                default: avma=l; return gun;
              }
            }

            if (typ(p1[1])==t_INT && typ(p1[2])==t_INT)
            { 
              tetpil=avma; return gerepile(l,tetpil,gcopy(y));
            }

            p1=gdiv(y,x);
            if (typ(p1[1])==t_INT && typ(p1[2])==t_INT)
            { 
              tetpil=avma; return gerepile(l,tetpil,gcopy(x));
            }
            p1=scalcontent(y); tetpil=avma;
            return gerepile(l,tetpil,ggcd(x,p1));

          case t_PADIC: case t_QUAD:
            p1=scalcontent(x); tetpil=avma;
            return gerepile(l,tetpil,ggcd(p1,y));
        }

      case t_PADIC:
        switch(ty)
        {
          case t_PADIC:
            if (!gegal((GEN)x[2],(GEN)y[2])) return gun;
            return gpuigs((GEN)y[2],min(valp(y),valp(x)));

          case t_QUAD:
            p1=scalcontent(y); tetpil=avma;
            return gerepile(l,tetpil,ggcd(p1,x));
          default: return gun;
        }

      case t_QUAD:
        p1=gdiv(x,y);
        if (gcmp0((GEN)p1[3]))
        {
          tetpil=avma; p1=(GEN)p1[2];
          p1 = (typ(p1)==t_INT) ? gcopy(y) : gdiv(y,(GEN)p1[2]);
          return gerepile(l,tetpil,p1);
        }

        if (typ(p1[2])==t_INT && typ(p1[3])==t_INT)
        { 
          tetpil=avma; return gerepile(l,tetpil,gcopy(y));
        }

        p1=gdiv(y,x);
        if (typ(p1[2])==t_INT && typ(p1[3])==t_INT)
        { 
          tetpil=avma; return gerepile(l,tetpil,gcopy(x));
        }
        p1=scalcontent(y); tetpil=avma;
        return gerepile(l,tetpil,ggcd(p1,x));

      default: return gun;
    }
    p1=content(y); tetpil=avma; return gerepile(l,tetpil,ggcd(x,p1));
  }

  vx=gvar9(x); vy=gvar9(y);
  if (vy<vx)
  { 
    p1=content(y); tetpil=avma; return gerepile(l,tetpil,ggcd(p1,x));
  }
  if (vx<vy)
  { 
    p1=content(x); tetpil=avma; return gerepile(l,tetpil,ggcd(p1,y));
  }

  switch(tx)
  {
    case t_POLMOD:
      switch(ty)
      {
	case t_POLMOD:
	  z=cgetg(3,t_POLMOD);
	  z[1]=gegal((GEN)x[1],(GEN)y[1]) ? copyifstack(x[1]):
	                                    lgcd((GEN)x[1],(GEN)y[1]);
	  if (lgef(z[1])<=3) z[2]=zero;
	  else
	  {
	    l=avma; p1=ggcd((GEN)z[1],(GEN)x[2]);
	    if (lgef(p1)>3)
	    { 
	      tetpil=avma; p1=gerepile(l,tetpil,ggcd(p1,(GEN)y[2]));
	    }
	    z[2]=(long)p1;
	  }
	  return z;

	case t_POL:
	  z=cgetg(3,t_POLMOD); z[1]=copyifstack(x[1]);
	  l=avma; p1=ggcd((GEN)x[1],(GEN)x[2]);
	  if (lgef(p1)>3) { tetpil=avma; p1=gerepile(l,tetpil,ggcd(y,p1)); }
	  z[2]=(long)p1; return z;

	case t_RFRAC:
	  p1=ggcd((GEN)x[1],(GEN)y[2]);
	  if (!gcmp1(p1)) err(gcder1);
	  tetpil=avma; return gerepile(l,tetpil,ggcd((GEN)y[1],x));

	case t_RFRACN:
	  p1=gred_rfrac(y); tetpil=avma;
	  return gerepile(l,tetpil,ggcd(p1,x));
      }
      break;
      
    case t_POL:
      switch(ty)
      {
	case t_POL:
	  return srgcd(x,y);

	case t_SER:
	  return gpuigs(polx[vx],min(valp(y),gval(x,vx)));

	case t_RFRAC: case t_RFRACN: av=avma; z=cgetg(3,ty);
          z[1]=lgcd(x,(GEN)y[1]);
          if (ty == t_RFRACN)
          {
            z[2]=lcopy((GEN)y[2]); return z;
          }
          z[2]=y[2]; return gerepileupto(av,gred_rfrac(z));
      }
      break;

    case t_SER:
      switch(ty)
      {
	case t_SER:
	  return gpuigs(polx[vx],min(valp(x),valp(y)));

	case t_RFRAC: case t_RFRACN:
	  return gpuigs(polx[vx],min(valp(x),gval(y,vx)));
      }
      break;

    case t_RFRAC: case t_RFRACN: av=avma; z=cgetg(3,ty);
      if (!is_rfrac_t(ty)) 
        err(talker,"forbidden gcd rational function with vector/matrix");
      z[2]=lmul((GEN)x[2],(GEN)y[2]); l=avma;
      p1=gmul((GEN)x[1],(GEN)y[2]);
      p2=gmul((GEN)x[2],(GEN)y[1]); p1=ggcd(p1,p2);
      if (ty==t_RFRACN)
      {
        tetpil=avma; z[1]=lpile(l,tetpil,p1);
        return z;
      }
      z[1]=(long)p1; return gerepileupto(av,gred_rfrac(z));
  }
  err(talker,"gcd vector/matrix with a forbidden type");
  return NULL; /* not reached */
}

GEN
glcm(GEN x, GEN y)
{
  long av=avma,tetpil,tx,ty=typ(y),i,l;
  GEN p1,p2,z;

  if (is_matvec_t(ty))
  { 
    l=lg(y); z=cgetg(l,ty);
    for (i=1; i<l; i++) z[i]=(long)glcm(x,(GEN)y[i]);
    return z;
  }
  tx=typ(x);
  if (is_matvec_t(tx))
  { 
    l=lg(x); z=cgetg(l,tx);
    for (i=1; i<l; i++) z[i]=(long)glcm((GEN)x[i],y);
    return z;
  }
  if (gcmp0(x)) return gzero;
  if (tx==t_INT && ty==t_INT)
  {
    p1=mppgcd(x,y); p2=mulii(x,y); 
    if (signe(p2)<0) setsigne(p2,1);
    /* should be diviiexact. But still buggy...*/
    tetpil=avma; return gerepile(av,tetpil,divii(p2,p1));
  }
  p1=ggcd(x,y); p2=gmul(x,y); 
  if (typ(p2)==t_INT && signe(p2)<0) setsigne(p2,1);
  tetpil=avma; return gerepile(av,tetpil,gdiv(p2,p1));
}

static GEN
polgcdnun(GEN x, GEN y)
{
  long av,av1;
  GEN p1,yorig;

  av=avma; yorig=y;
  for(;;)
  {
    av1=avma; p1=gres(x,y);
    if (gcmp0(p1))
    { 
      avma=av1; if (y!=yorig) return gerepileupto(av,y);
      avma=av; return gcopy(y);
    }
    x=y; y=p1;
  }
}

/* renvoie 1 si probablement un corps simple, 0 sinon */
static int
issimplefield(GEN x)
{
  long lx,i;
  switch(typ(x))
  {
    case t_REAL: case t_INTMOD: case t_PADIC: case t_SER:
      return 1;
    case t_POL:
      lx=lgef(x);
      for (i=2; i<lx; i++)
	if (!issimplefield((GEN)x[i])) return 0;
      return 1;
    case t_COMPLEX: case t_POLMOD:
      return issimplefield((GEN)x[1]) || issimplefield((GEN)x[2]);
  }
  return 0;
}

static int
isinexactfield(GEN x)
{
  long lx,i;
  switch(typ(x))
  {
    case t_REAL: case t_PADIC: case t_SER:
      return 1;
    case t_POL:
      lx=lgef(x);
      for (i=2; i<lx; i++) 
	if (!isinexactfield((GEN)x[i])) return 0;
      return 1;
    case t_COMPLEX: case t_POLMOD:
      return isinexactfield((GEN)x[1]) || isinexactfield((GEN)x[2]);
  }
  return 0;
}

static GEN
gcdmonome(GEN x, GEN y)
{
  long tetpil,av=avma, lx=lgef(x), v=varn(x), e=gval(y,v);
  GEN p1,p2;

  if (lx-3<e) e=lx-3;
  p1=ggcd(leading_term(x),content(y)); p2=gpuigs(polx[v],e);
  tetpil=avma; return gerepile(av,tetpil,gmul(p1,p2));
}

/***********************************************************************/
/**                                                                   **/
/**                         BEZOUT GENERAL                            **/
/**                                                                   **/
/***********************************************************************/

static GEN
polinvinexact(GEN x, GEN y)
{
  long i,dx=lgef(x)-3,dy=lgef(y)-3,lz, av=avma, tetpil;
  GEN v,z;

  z=cgetg(dy+2,t_POL); lz=dx+dy;
  z[1]=evalsigne(1)+evalvarn(varn(y))+evallgef(dy+2);
  v=cgetg(lz+1,t_COL); for (i=1; i<lz; i++) v[i]=zero;
  v[lz]=un; v=gauss(sylvestermatrix(y,x),v);
  for (i=2; i<dy+2; i++) z[i]=v[lz-i+2];
  z = normalizepol(z); tetpil = avma; 
  return gerepile(av,tetpil,gcopy(z));
}

static GEN
polinvmod(GEN x, GEN y)
{
  long av,av1,tx,vx=varn(x),vy=varn(y);
  GEN u,v,d,p1;

  while (vx!=vy)
  {
    if (vx > vy)
    { 
      d=cgetg(3,t_RFRAC); d[1]=(long)polun[vx];
      d[2]=lcopy(x); return d;
    }
    else
    {
      if (lgef(x)!=3) err(talker,"non-invertible polynomial in polinvmod");
      x=(GEN)x[2]; vx=gvar(x);
    }
  }
  tx=typ(x);
  if (tx==t_POL)
  {
    if (isinexactfield(x) || isinexactfield(y))
      return polinvinexact(x,y);

    av=avma; d=subresext(x,y,&u,&v);
    if (gcmp0(d)) err(talker,"non-invertible polynomial in polinvmod");
    if (typ(d)==t_POL && varn(d)==vx)
    {
      if (lgef(d)>3) err(talker,"non-invertible polynomial in polinvmod");
      d=(GEN)d[2];
    }
    av1=avma; return gerepile(av,av1,gdiv(u,d));
  }
  if (!is_rfrac_t(tx)) err(typeer,"polinvmod");
  av=avma; p1=gmul((GEN)x[1],polinvmod((GEN)x[2],y));
  av1=avma; return gerepile(av,av1,gmod(p1,y));
}

GEN
gbezout(GEN x, GEN y, GEN *u, GEN *v)
{
  long tx=typ(x),ty=typ(y);

  if (tx==t_INT && ty==t_INT) return bezout(x,y,u,v);
  if (!is_extscalar_t(tx) || !is_extscalar_t(ty)) err(typeer,"gbezout");
  return bezoutpol(x,y,u,v);
}

GEN
vecbezout(GEN x, GEN y)
{
  GEN z=cgetg(4,t_VEC);
  z[3]=(long)gbezout(x,y,(GEN*)(z+1),(GEN*)(z+2));
  return z;
}

GEN
vecbezoutres(GEN x, GEN y)
{
  GEN z=cgetg(4,t_VEC);
  z[3]=(long)subresext(x,y,(GEN*)(z+1),(GEN*)(z+2));
  return z;
}

/*******************************************************************/
/*                                                                 */
/*                    CONTENU ET PARTIE PRIMITIVE                  */
/*                                                                 */
/*******************************************************************/

GEN
content(GEN x)
{
  long av,lx,tetpil,i,f,tx=typ(x);
  GEN p1,p2;

  if (is_const_t(tx)) return gcopy(x);
  lx=lg(x);
  switch(tx)
  {
    case t_POLMOD:
      return content((GEN)x[2]);

    case t_RFRAC: case t_RFRACN:
      av=avma; p1=content((GEN)x[1]); p2=content((GEN)x[2]);
      tetpil=avma; return gerepile(av,tetpil,gdiv(p1,p2));

    case t_VEC: case t_COL: case t_MAT:
      if (lx==1) return gun;
      tetpil=av=avma; p1=content((GEN)x[1]);
      for (i=2; i<lx; i++) { tetpil=avma; p1=ggcd(p1,content((GEN)x[i])); }
      return gerepile(av,tetpil,p1);

    case t_POL:
      lx=lgef(x);
    case t_SER:
      if (!signe(x) && (tx==t_SER || lx==2)) return gzero;
  }
  f=1;
  if (tx==t_QFR) i=lx-2;
  else
  { 
    for (i=lontyp[tx]; i<lx && f; i++)
      f=(typ(x[i])==t_INT);
    i=lx-1;
  }
  p1=(GEN)x[i]; av=tetpil=avma;
  if (f)
  {
    while (i>lontyp[tx] && !gcmp1(p1))
    {
      i--; tetpil=avma; p1=mppgcd(p1,(GEN)x[i]);
    }
  }
  else
  {
    while (i>lontyp[tx])
    {
      i--; tetpil=avma; p1=ggcd(p1,(GEN)x[i]);
    }
  }
  if (av==avma) return gcopy(p1);
  return gerepile(av,tetpil,p1);
}

static GEN
scalcontent(GEN x)
{
  switch(typ(x))
  {
    case t_INT: case t_FRAC: case t_FRACN:
      return x;

    case t_REAL: case t_PADIC:
      return gun;

    case t_INTMOD: case t_COMPLEX:
      return ggcd((GEN)x[1],(GEN)x[2]);

    case t_QUAD:
      return ggcd((GEN)x[2],(GEN)x[3]);

    case t_POLMOD:
      return content((GEN)x[2]);
  }
  return content(x);
}

/*******************************************************************/
/*                                                                 */
/*                         SOUS RESULTANT                          */
/*                                                                 */
/*******************************************************************/
static GEN
psres(GEN x, GEN y)
{
  long av=avma,tetpil, dx = lgef(x), dy = lgef(y);
  GEN p1;

  if (dx < dy) err(bugparier,"deg(x)<deg(y) in psres");
  p1=gpuigs((GEN)y[dy-1],dx-dy+1);
  p1=gmul(p1,x); tetpil=avma;
  return gerepile(av,tetpil,gres(p1,y));
}

/* Si sol != NULL:
 *   met dans *sol le dernier polynome non nul de la polynomial remainder
 *   sequence si elle a ete effectuee, 0 sinon
 */
GEN
subresall(GEN x, GEN y, GEN *sol)
{
  long degq,av,tetpil,tx=typ(x),ty=typ(y),dx,dy,du,dv,dr,signh;
  GEN g,h,r,p1,p2,p3,p4,u,v;
  GEN *gptr[2];

  if (gcmp0(x) || gcmp0(y)) { if (sol) *sol=gzero; return gzero; }
  if (is_scalar_t(tx) || is_scalar_t(ty))
  {
    if (sol) *sol=gzero;
    if (tx==t_POL) return gpuigs(y,lgef(x)-3);
    if (ty==t_POL) return gpuigs(x,lgef(y)-3);
    return gun;
  }
  if (tx!=t_POL || ty!=t_POL) err(typeer,"subresall");

  if (varn(x)!=varn(y))
    return (varn(x)<varn(y)) ? gpuigs(y,lgef(x)-3) : gpuigs(x,lgef(y)-3);
  if (isinexactfield(x) || isinexactfield(y))
  { 
    if (sol) *sol=gzero;
    return resultant2(x,y);
  }
  dx=lgef(x); dy=lgef(y);
  if (dx<dy) { p1=x; x=y; y=p1; tx=dx; dx=dy; dy=tx; signh= -1; }
  else signh=1;
  av=avma; p4=content(y);
  if (dy==3)
  {
    if (sol) *sol=gzero;
    tetpil=avma; return gerepile(av,tetpil,gpuigs(p4,dx-3));
  }
  p3=content(x); u=gdiv(x,p3); v=gdiv(y,p4);
  g=gun; h=gun;
  for(;;)
  {
    r = psres(u,v); dr = lgef(r);
    if (dr<=2) break;

    du=lgef(u); dv=lgef(v);
    degq=du-dv; u=v;
    p1 = g; g = leading_term(u);
    switch(degq)
    {
      case 0: break;
      case 1:
        p1 = gmul(h,p1); h = g; break;
      default:
        p1 = gmul(gpuigs(h,degq),p1);
        h = gdiv(gpuigs(g,degq), gpuigs(h,degq-1));
    }
    if ((du & 1) == 0 && (dv & 1) == 0) signh= -signh;
    v = gdiv(r,p1);
    if (dr==3) break;
  }
  if (dr==2)
  {
    if (sol) { tetpil=avma; *sol=gerepile(av,tetpil,gcopy(v)); }
    else avma=av;
    return gzero;
  }

  if (dv==4) { tetpil=avma; p2=gcopy((GEN)v[2]); }
  else
  {
    if (dv == 3) err(bugparier,"subres");
    p1=gpuigs((GEN)v[2],dv-3); p2=gpuigs(h,dv-4);
    tetpil=avma; p2=gdiv(p1,p2);
  }
  if (!gcmp1(p3)) { p1=gpuigs(p3,dy-3); tetpil=avma; p2=gmul(p2,p1); }
  if (!gcmp1(p4)) { p1=gpuigs(p4,dx-3); tetpil=avma; p2=gmul(p2,p1); }
  if (signh<0) { tetpil=avma; p2=gneg(p2); }

  gptr[0]=&p2; if (sol) { *sol=gcopy(u); gptr[1]=sol; }
  gerepilemanysp(av,tetpil,gptr,sol?2:1);
  return p2;
}

GEN
subres(GEN x, GEN y) { return subresall(x,y,NULL); }

static GEN
scalar_res(GEN x, GEN y, GEN *U, GEN *V)
{
  long dx=lgef(x)-4;
  *V=gpuigs(y,dx); *U=gzero; return gmul(y,*V);
}

/* calcule U et V tel que Ux+By=resultant(x,y) */
GEN
subresext(GEN x, GEN y, GEN *U, GEN *V)
{
  long degq,av,tetpil,tx,ty,dx,dy,du,dv,dr,signh;
  GEN z,g,h,r,p1,p2,p3,p4,u,v,lpu,um1,uze, *gptr[2];

  if (gcmp0(x) || gcmp0(y)) { *U = *V = gzero; return gzero; }
  tx=typ(x); ty=typ(y);
  if (is_scalar_t(tx) || is_scalar_t(ty))
  {
    if (tx==t_POL) return scalar_res(x,y,U,V);
    if (ty==t_POL) return scalar_res(y,x,V,U);
    *U=ginv(x); *V=gzero; return gun;
  }
  if (tx!=t_POL || ty!=t_POL) err(typeer,"subresext");
  if (varn(x)!=varn(y))
    return (varn(x)<varn(y))? scalar_res(x,y,U,V)
                            : scalar_res(y,x,V,U);
  dx=lgef(x); dy=lgef(y);
  if (dx>=dy) signh=1;
  else
  { 
    GEN *W = U; U=V; V=W;
    du=dx; dx=dy; dy=du; p1=x; x=y; y=p1;
    signh = -1;
  }
  av=avma; p4=content(y);
  if (dy==3)
  {
    tetpil=avma; p1=gpuigs(p4,dx-4); p4=gmul(p1,p4);
    gptr[0]=&p1; gptr[1]=&p4;
    gerepilemanysp(av,tetpil,gptr,2);
    *U=gzero; *V=p1; return p4;
  }
  p3=content(x); u=gdiv(x,p3); v=gdiv(y,p4);
  g=gun; h=gun; um1=gun; uze=gzero;
  for(;;)
  {
    du=lgef(u); dv=lgef(v); degq=du-dv;
    lpu=gpuigs((GEN)v[dv-1],degq+1);
    p1=gmul(lpu,u); p2=poldivres(p1,v,&r);
    dr=lgef(r); if (dr<=2) break;

    p1=gsub(gmul(lpu,um1),gmul(p2,uze));
    um1=uze; uze=p1; u=v;
    p1 = g; g = leading_term(u);
    switch(degq)
    {
      case 0: break;
      case 1: p1 = gmul(h,p1); h = g; break;
      default:
        p1 = gmul(gpuigs(h,degq),p1);
        h = gdiv(gpuigs(g,degq), gpuigs(h,degq-1));
    }
    if ((du & 1) == 0 && (dv & 1) == 0) signh= -signh;
    v=gdiv(r,p1); uze=gdiv(uze,p1);
    if (dr==3) break;
  }
  if (dr==2) { *U=gzero; *V=gzero; avma=av; return gzero; }

  p2=(dv==4)?gun:gpuigs(gdiv((GEN)v[2],h),dv-4);
  if (!gcmp1(p3)) p2=gmul(p2,gpuigs(p3,dy-3));
  if (!gcmp1(p4)) p2=gmul(p2,gpuigs(p4,dx-3));
  if (signh<0) p2=gneg(p2);
  p3 = gcmp1(p3)? p2: gdiv(p2,p3);

  tetpil=avma; z=gmul((GEN)v[2],p2); uze=gmul(uze,p3);
  gptr[0]=&z; gptr[1]=&uze; gerepilemanysp(av,tetpil,gptr,2);

  av=avma; p1 = gsub(z,gmul(uze,x)); 
  tetpil = avma; p1 = poldivres(p1,y,&r);
  if (!gcmp0(r)) err(bugparier,"subresext (bug1)");
  cgiv(r);

  *U=uze; *V=gerepile(av,tetpil,p1); return z;
}

static GEN
scalar_bezout(GEN x, GEN y, GEN *U, GEN *V)
{ 
  long v = varn(x);
  *U=gzero; *V=gdiv(polun[v],y); return polun[v];
}

static GEN
zero_bezout(GEN y, GEN *U, GEN *V)
{
  GEN x=content(y); 
  *U=gzero; *V = gdiv(polun[varn(y)],x); return gmul(y,*V);
}

/* calcule U et V tel que Ux+Vy=GCD(x,y) par le sous-resultant */
GEN
bezoutpol(GEN x, GEN y, GEN *U, GEN *V)
{
  long degq,av,tetpil,tx,ty,dx,dy,du,dv,dr;
  GEN g,h,r,p1,p2,p3,p4,u,v,lpu,um1,uze,vze,xprim,yprim;
  GEN *gptr[3];

  if (gcmp0(x)) return zero_bezout(y,U,V);
  if (gcmp0(y)) return zero_bezout(x,V,U);
  tx=typ(x); ty=typ(y); av=avma;
  if (is_scalar_t(tx) || is_scalar_t(ty))
  {
    if (tx==t_POL) return scalar_bezout(x,y,U,V);
    if (ty==t_POL) return scalar_bezout(y,x,V,U);
    *U=ginv(x); *V=gzero; return polun[0];
  }
  if (tx!=t_POL || ty!=t_POL) err(typeer,"bezoutpol");
  if (varn(x)!=varn(y))
    return (varn(x)<varn(y))? scalar_bezout(x,y,U,V)
                            : scalar_bezout(y,x,V,U);
  dx=lgef(x); dy=lgef(y);
  if (dx<dy)
  {
    GEN *W=U; U=V; V=W; 
    p1=x; x=y; y=p1; du=dx; dx=dy; dy=du;
  }
  if (dy==3) return scalar_bezout(x,y,U,V);

  p3=content(x); p4=content(y); u=gdiv(x,p3); v=gdiv(y,p4);
  xprim=u; yprim=v; g=gun; h=gun; um1=gun; uze=gzero;
  for(;;)
  {
    du=lgef(u); dv=lgef(v); degq=du-dv;
    lpu=gpuigs((GEN)v[dv-1],degq+1);
    p1=gmul(lpu,u); p2=poldivres(p1,v,&r);
    dr=lgef(r); if (dr<=2) break;
    p1=gsub(gmul(lpu,um1),gmul(p2,uze)); um1=uze; uze=p1;

    u=v; p1 = g; g  = leading_term(u);
    switch(degq)
    {
      case 0: break;
      case 1:
        p1 = gmul(h,p1); h = g; break;
      default:
        p1 = gmul(gpuigs(h,degq), p1);
        h = gdiv(gpuigs(g,degq), gpuigs(h,degq-1));
    }
    v=gdiv(r,p1); uze=gdiv(uze,p1);
    if (dr==3) break;
  }
  vze=poldivres(gsub(v,gmul(uze,xprim)),yprim,&r);
  if (!gcmp0(r)) err(warner,"non-exact computation in bezoutpol");
  uze=gdiv(uze,p3); vze=gdiv(vze,p4); p1=ginv(content(v));

  tetpil=avma; uze=gmul(uze,p1); vze=gmul(vze,p1); p1=gmul(v,p1);
  gptr[0]=&uze; gptr[1]=&vze; gptr[2]=&p1;
  gerepilemanysp(av,tetpil,gptr,3);
  *U=uze; *V=vze; return p1;
}

/*******************************************************************/
/*                                                                 */
/*               RESULTANT PAR MATRICE DE SYLVESTER                */
/*                                                                 */
/*******************************************************************/

GEN
resultant2(GEN x, GEN y)
{
  long av,tetpil,d,dx,dy,i,j,tx,ty;
  GEN p1,p2;

  if (gcmp0(x) || gcmp0(y)) return gzero;
  tx=typ(x),ty=typ(y);
  if (is_scalar_t(tx)||is_scalar_t(ty))
  {
    if (tx==t_POL) return gpuigs(y,lgef(x)-3);
    if (ty==t_POL) return gpuigs(x,lgef(y)-3);
    return gun;
  }
  if (tx!=t_POL || ty!=t_POL) err(typeer,"resultant2");
  if (varn(x)!=varn(y))
    return (varn(x)<varn(y))?gpuigs(y,lgef(x)-3):gpuigs(x,lgef(y)-3);

  av=avma; dx=lgef(x)-3; dy=lgef(y)-3; d=dx+dy;
  if (dx<dy) { p1=x; x=y; y=p1; i=dx; dx=dy; dy=i; }
  p1=cgetg(d+1,t_MAT);
  for (j=1; j<=dy; j++)
  {
    p2=cgetg(d+1,t_COL); p1[j]=(long)p2;
    for (i=1; i<j; i++) p2[i]=zero;
    for (   ; i<=j+dx; i++) p2[i]=x[dx-i+j+2];
    for (   ; i<=d; i++) p2[i]=zero;
  }
  for (j=1; j<=dx; j++)
  {
    p2=cgetg(d+1,t_COL); p1[j+dy]=(long)p2;
    for (i=1; i<j; i++) p2[i]=zero;
    for (   ; i<=j+dy; i++) p2[i]=y[dy-i+j+2];
    for (   ; i<=d; i++) p2[i]=zero;
  }
  tetpil=avma; return gerepile(av,tetpil,det(p1));
}

GEN
polresultant0(GEN x,GEN y,long flag)
{
  switch(flag)
  {
    case 0: return subres(x,y);
    case 1: return resultant2(x,y);
    default: err(flagerr);
  }
  return NULL; /* not reached */
}

GEN
sylvestermatrix(GEN x, GEN y)
{
  long d,dx,dy,i,j;
  GEN p1,p2;

  if (typ(x)!=t_POL || typ(y)!=t_POL) err(typeer,"sylvestermatrix");
  if (varn(x) != varn(y)) 
    err(talker,"not the same variables in sylvestermatrix");
  dx=lgef(x)-3; dy=lgef(y)-3; d=dx+dy;
  p1=cgetg(d+1,t_MAT);
  for (j=1; j<=dy; j++)
  {
    p2=cgetg(d+1,t_COL); p1[j]=(long)p2;
    for (i=1; i<j; i++) p2[i]=zero;
    for (   ; i<=j+dx; i++) p2[i]=lcopy((GEN)x[dx-i+j+2]);
    for (   ; i<=d; i++) p2[i]=zero;
  }
  for (j=1; j<=dx; j++)
  {
    p2=cgetg(d+1,t_COL); p1[j+dy]=(long)p2;
    for (i=1; i<j; i++) p2[i]=zero;
    for (   ; i<=j+dy; i++) p2[i]=lcopy((GEN)y[dy-i+j+2]);
    for (   ; i<=d; i++) p2[i]=zero;
  }
  return p1;
}

/*******************************************************************/
/*                                                                 */
/*           P.G.C.D PAR L'ALGORITHME DU SOUS RESULTANT            */
/*                                                                 */
/*******************************************************************/

GEN
srgcd(GEN x, GEN y)
{
  long av,av1,tetpil,tx=typ(x),ty=typ(y),dx,dy,vx,lim;
  GEN d,g,h,p1,p2,u,v;
  GEN *gptr[4];

  if (!signe(y)) return gcopy(x);
  if (!signe(x)) return gcopy(y);
  if (is_scalar_t(tx) || is_scalar_t(ty)) return gun;
  if (tx!=t_POL || ty!=t_POL) err(typeer,"srgcd");
  vx=varn(x); if (vx!=varn(y)) return gun;
  if (ismonome(x)) return gcdmonome(x,y);
  if (ismonome(y)) return gcdmonome(y,x);

  av=avma;
  if (issimplefield(x) || issimplefield(y)) x = polgcdnun(x,y);
  else
  {
    dx=lgef(x); dy=lgef(y);
    if (dx<dy) { p1=x; x=y; y=p1; tx=dx; dx=dy; dy=tx; }
    p1=content(x); p2=content(y); d=ggcd(p1,p2);

    tetpil=avma; d=gmul(d,polun[vx]);
    if (dy==3) return gerepile(av,tetpil,d);

    av1=avma; lim=(av1+bot)>>1;
    u=gdiv(x,p1); v=gdiv(y,p2); g=h=gun;
    for(;;)
    {
      GEN r = psres(u,v);
      long degq, du, dv, dr=lgef(r);

      if (dr<=3)
      { 
        if (gcmp0(r)) break;
        avma=av1; return gerepile(av,tetpil,d);
      }
      du=lgef(u); dv=lgef(v); degq=du-dv; u=v;
      switch(degq)
      {
        case 0:
          v = gdiv(r,g);
          g = leading_term(u);
          break;
        case 1:
          v = gdiv(r,gmul(h,g));
          h = g = leading_term(u);
          break;
        default:
          v = gdiv(r,gmul(gpuigs(h,degq),g));
          g = leading_term(u);
          h = gdiv(gpuigs(g,degq), gpuigs(h,degq-1));
      }
      if (low_stack(lim, (av1+bot)>>1))
      {
        if(DEBUGMEM>1) err(warnmem,"srgcd");
        gptr[0]=&u; gptr[1]=&v; gptr[2]=&g; gptr[3]=&h;
        gerepilemany(av1,gptr,4);
      }
    }
    p1 = content(v); if (!gcmp1(p1)) v = gdiv(v,p1);
    x = gmul(d,v);
  }

  if (typ(x)!=t_POL) x = gmul(polun[vx],x);
  else
  {
    p1=leading_term(x); ty=typ(p1);
    if ((is_frac_t(ty) || is_intreal_t(ty)) && gsigne(p1)<0) x = gneg(x);
  }
  return gerepileupto(av,x);
}

GEN
discsr(GEN x)
{
  long dx,av=avma,tetpil,tx=typ(x),i;
  GEN z,p1,p2;

  switch(tx)
  {
    case t_COMPLEX:
      return stoi(-4);

    case t_QUAD:
      return discsr((GEN)x[1]);

    case t_POL:
      if (gcmp0(x)) return gzero;
      dx=lgef(x); p1=deriv(x,varn(x)); p1=subres(x,p1);
      p1=gdiv(p1,(GEN)x[dx-1]);
      if (((dx-3)&3)>1) p1 = gneg(p1);
      return gerepileupto(av,p1);

    case t_POLMOD:
      return discsr((GEN)x[1]);

    case t_QFR: case t_QFI:
      p1=sqri((GEN)x[2]);
      p2=shifti(mulii((GEN)x[1],(GEN)x[3]),2); tetpil=avma;
      return gerepile(av,tetpil,subii(p1,p2));

    case t_VEC: case t_COL: case t_MAT:
      dx=lg(x); z=cgetg(dx,tx);
      for (i=1; i<dx; i++) z[i]=(long)discsr((GEN)x[i]);
      return z;
  }
  err(typeer,"discsr");
  return NULL; /* not reached */
}

GEN
reduceddiscsmith(GEN pol)
{
  long av=avma,tetpil,i,j,n,v;
  GEN polp,polpa,alpha,q,p1,m;

  if (typ(pol)!=t_POL) err(typeer,"reduceddiscsmith");
  n=lgef(pol)-3; v=varn(pol);
  if (n<=0) err(constpoler,"reduceddiscsmith");
  polp=deriv(pol,v);
  polpa=gmodulcp(polp,pol);
  alpha=gmodulcp(polx[v],pol);
  m=cgetg(n+1,t_MAT);
  for (j=1; j<=n; j++)
  {
    q=(GEN)polpa[2]; p1=cgetg(n+1,t_COL); m[j]=(long)p1;
    for (i=1; i<=n; i++) p1[i]=(long)truecoeff(q,i-1);
    if (j<n) polpa=gmul(alpha,polpa);
  }
  tetpil=avma; return gerepile(av,tetpil,smith(m));
}

/***********************************************************************/
/**							              **/
/**	                 ALGORITHME DE STURM                          **/
/**	         (number of real roots of x in ]a,b])		      **/
/**								      **/
/***********************************************************************/

/* if a (resp. b) is NULL, set it to -oo (resp. +oo) */
long
sturmpart(GEN x, GEN a, GEN b)
{
  long av,sl,sr,s,t,r1;
  GEN g,h,u,v;

  if (typ(x) != t_POL) err(typeer,"sturm");
  if (gcmp0(x)) err(zeropoler,"sturm");
  s=lgef(x); if (s==3) return 0;

  sl = gsigne(leading_term(x));
  if (s==4)
  {
     s = b ? gsigne(poleval(x,b)):  sl;
     t = a ? gsigne(poleval(x,a)): -sl;
    return (s == t)? 0: 1;
  }

  av=avma;
  u=gdiv(x,content(x)); v=deriv(x,varn(x)); v=gdiv(v,content(v));
  g=gun; h=gun;
  s = b ? gsigne(poleval(u,b)): sl;
  t = a ? gsigne(poleval(u,a))
        : ((lgef(u)&1)? sl: -sl);
  r1=0; 
  sr = b ? gsigne(poleval(v,b)): s;
  if (sr)
    if (!s) s=sr;
    else if (sr!=s) { s= -s; r1--; }

  sr = a ? gsigne(poleval(v,a)): -t;
  if (sr)
    if (!t) t=sr;
    else if (sr!=t) { t= -t; r1++; }
  for(;;)
  { 
    GEN r=psres(u,v);
    long du=lgef(u), dv=lgef(v), dr=lgef(r), degq=du-dv;

    if (dr<=2) err(talker,"not a squarefree polynomial in sturm");
    if (gsigne(leading_term(v)) > 0 || degq&1) r=gneg(r);
    sl = gsigne((GEN) r[dr-1]);
    sr = b ? gsigne(poleval(r,b)): sl;
    if (sr)
      if (!s) s=sr;
      else if (sr!=s) { s= -s; r1--; }

    sr = a ? gsigne(poleval(r,a))
           : ((dr&1)? sl: -sl);
    if (sr)
      if (!t) t=sr;
      else if (sr!=t) { t= -t; r1++; }

    if (dr==3) { avma=av; return r1; }

    u=v;
    switch(degq)
    {
      case 0:
        v = gdiv(r,g); 
        g = gabs(leading_term(u),DEFAULTPREC);
        break;
      case 1:
        v = gdiv(r,gmul(h,g)); 
        h = g = gabs(leading_term(u),DEFAULTPREC);
        break;
      default:
        v = gdiv(r,gmul(gpuigs(h,degq),g));
        g = gabs(leading_term(u),DEFAULTPREC);
        h = gdiv(gpuigs(g,degq), gpuigs(h,degq-1));
    }
  }
}

/*******************************************************************/
/*                                                                 */
/*         POLYNOME QUADRATIQUE ASSOCIE A UN DISCRIMINANT          */
/*                                                                 */
/*******************************************************************/

GEN
quadpoly(GEN x)
{
  long res,l,tetpil,i,sx, tx = typ(x);
  GEN y,p1;

  if (is_matvec_t(tx))
  {
    l=lg(x); y=cgetg(l,tx);
    for (i=1; i<l; i++) y[i]=(long)quadpoly((GEN)x[i]);
    return y;
  }
  if (tx!=t_INT) err(arither1);
  sx=signe(x);
  if (!sx) err(talker,"zero discriminant in quadpoly");
  y=cgetg(5,t_POL);
  y[1]=evalsigne(1) | evallgef(5); y[4]=un;
  res=mod4(x); if (sx<0 && res) res=4-res;
  if (res>1) err(funder2,"quadpoly");

  l=avma; p1=shifti(x,-2); setsigne(p1,-signe(p1));
  y[2] = (long) p1;
  if (!res) y[3] = zero;
  else
  {
    if (sx<0) { tetpil=avma; y[2] = lpile(l,tetpil,addsi(1,p1)); }
    y[3] = lnegi(gun);
  }
  return y;
}

GEN
quadgen(GEN x)
{
  GEN y=cgetg(4,t_QUAD);
  y[1]=lquadpoly(x); y[2]=zero; y[3]=un; return y;
}

/*******************************************************************/
/*                                                                 */
/*                    INVERSE MODULO GENERAL                       */
/*                                                                 */
/*******************************************************************/

GEN
ginvmod(GEN x, GEN y)
{
  long tx=typ(x);

  switch(typ(y))
  {
    case t_POL:
      if (tx==t_POL) return polinvmod(x,y);
      if (is_scalar_t(tx)) return ginv(x);
      break;
    case t_INT:
      if (tx==t_INT) return mpinvmod(x,y);
      if (tx==t_POL) return gzero;
  }
  err(typeer,"ginvmod");
  return NULL; /* not reached */
}

/***********************************************************************/
/**							              **/
/**		          POLYGONE DE NEWTON			      **/
/**								      **/
/***********************************************************************/

GEN
newtonpoly(GEN x, GEN p)
{
  GEN y;
  long n,*vval,i,a,b,c,u1,u2,r1,r2;

  if (typ(x)!=t_POL) err(typeer,"newtonpoly");
  n=lgef(x)-3; if (n<=0) { y=cgetg(1,t_VEC); return y; }
  vval = (long *) gpmalloc(sizeof(long)*(n+1));
  for (i=0; i<=n; i++)
    vval[i] = gcmp0((GEN)x[i+2])? EXP220: ggval((GEN)x[i+2],p);
  a=0; b=1; y=cgetg(n+1,t_VEC);
  while (b<=n)
  {
    u1=vval[a]-vval[b]; u2=b-a;
    for (c=b+1; c<=n; c++)
    {
      r1=vval[a]-vval[c]; r2=c-a;
      if (u1*r2<=u2*r1) { u1=r1; u2=r2; b=c; }
    }
    for (i=a+1; i<=b; i++) y[i]=ldivgs(stoi(u1),u2);
    a=b; b=a+1;
  }
  free(vval); return y;
}

/* Factor polynomial a on the number field defined by polynomial t */
GEN
polfnf(GEN a, GEN t)
{
  GEN y,p1,p2,u,g,fa,n,r,unt,f,b,pro;
  long av=avma,tetpil,lx,v,i,e,k,vt;

  if (typ(a)!=t_POL || typ(t)!=t_POL) err(typeer,"polfnf");
  if (gcmp0(a)) return gcopy(a);
  vt=varn(t); v=varn(a);
  if (vt<v)
    err(talker,"polynomial variable must be of higher priority than number field variable\nin factornf");
  unt=gmodulsg(1,t); u=gdiv(a,ggcd(a,deriv(a,v))); u=gmul(unt,u);
  setvarn(u,MAXVARN); g=lift(u); setvarn(u,v); k= -2;
  do
  {
    k++; n = gsub(polx[MAXVARN],gmulsg(k,polx[vt]));
    n = subres(t,gsubst(g,MAXVARN,n));
  }
  while (!issquarefree(n));
  fa=factor(n); fa=(GEN)fa[1]; lx=lg(fa);
  y=cgetg(3,t_MAT);
  p1=cgetg(lx,t_COL); y[1]=(long)p1;
  p2=cgetg(lx,t_COL); y[2]=(long)p2;
  for (i=1; i<lx; i++)
  {
    setvarn(fa[i],v);
    f=gsubst((GEN)fa[i],v,gadd(polx[v],gmulsg(k,gmodulcp(polx[vt],t))));
    pro=ggcd(u,gmul(unt,f));
    p1[i] = (typ(pro)==t_POL)? ldiv(pro,leading_term(pro)): (long)pro;
    e=0; b=poldivres(a,(GEN)p1[i],&r);
    while (gcmp0(r)) { a=b; e++; b=poldivres(a,(GEN)p1[i],&r); }
    p2[i]=lstoi(e);
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(y));
}

/* if fliso test for isomorphism, for inclusion otherwise. */
static GEN
nfiso0(GEN a, GEN b, long fliso)
{
  long av=avma,tetpil,n,m,i,c,va,vb,lx;
  GEN p1,p2,y,ain,bin,la,lb,da,db,fa,ex;

  if (typ(a)!=t_POL || typ(b)!=t_POL) err(typeer,"nfiso or nfincl");
  m=lgef(a)-3; n=lgef(b)-3;
  if (m<=0 || n<=0) 
    err(constpoler,"nfiso or nfincl");

  if (fliso)
    { if (n!=m) return gzero; }
  else
    { if (n%m) return gzero; }

  ain=a; bin=b; va=varn(a); vb=varn(b); setvarn(a,0); setvarn(b,0);
  p1=content(a); if (!gcmp1(p1)) a=gdiv(a,content(a));
  p1=content(b); if (!gcmp1(p1)) b=gdiv(b,content(b));
  la=(GEN)a[m+2];
  if (!gcmp1(la)) a=gmul(gpuigs(la,m-1),gsubst(a,0,gdiv(polx[0],la)));
  lb=(GEN)b[n+2];
  if (!gcmp1(lb)) b=gmul(gpuigs(lb,n-1),gsubst(b,0,gdiv(polx[0],lb)));

  da=discsr(a); db=discsr(b);
  if (fliso)
  {
    p1=gdiv(da,db);
    if (typ(p1)==t_FRAC) p1=gmul((GEN)p1[1],(GEN)p1[2]);
    if (typ(p1)!=t_INT) err(polrationer,"nfiso or nfincl");
    if (!carreparfait(p1)) { avma=av; return gzero; }
  }
  else
  {
    long q=n/m;

    if (typ(da)!=t_INT || typ(db)!=t_INT)
      err(polrationer,"nfiso or nfincl");
    fa=factor(da); ex=(GEN)fa[2]; p1=(GEN)fa[1]; lx=lg(p1);
    for (i=1; i<lx; i++)
      if (mod2((GEN)ex[i]) && !divise(db,gpuigs((GEN)p1[i],q)))
	{ avma=av; return gzero; }
  }

  fa=polfnf(a,b); ex=(GEN)fa[2]; p1=(GEN)fa[1]; lx=lg(p1); c=0;
  for (i=1; i<lx; i++)
  {
    if (!gcmp1((GEN)ex[i])) err(redpoler,"nfiso or nfincl");
    if (lgef(p1[i])==4) c++;
  }
  if (!c) { avma=av; return gzero; }
  y=cgetg(c+1,t_VEC); c=0;
  for (i=1; i<lx; i++)
    if (lgef(p1[i])==4)
    {
      p2=gneg(lift(gmael(p1,i,2)));
      if (!gcmp1(lb)) p2=gsubst(p2,0,gmul(polx[0],lb));
      y[++c]=gcmp1(la)? (long)p2: ldiv(p2,la);
    }
  setvarn(ain,va); setvarn(bin,vb);
  tetpil=avma; return gerepile(av,tetpil,gcopy(y));
}

static GEN
nfisisom00(GEN a, GEN b, long flag, long fliso)
{
  if (flag) return isisomfastall(a,b,fliso);

  if (typ(a)!=t_POL) { a=checknf(a); a=(GEN)a[1]; }
  if (typ(b)!=t_POL) { b=checknf(b); b=(GEN)b[1]; }
  return nfiso0(a,b,fliso);
}

GEN
nfiso(GEN a, GEN b)
{
  return nfiso0(a,b,1);
}

GEN
nfincl(GEN a, GEN b)
{
  return nfiso0(a,b,0);
}

GEN
nfisisom0(GEN a, GEN b,long flag)
{
  return nfisisom00(a,b,flag,1);
}

GEN
nfisincl0(GEN a, GEN b,long flag)
{
  return nfisisom00(a,b,flag,0);
}
