/********************************************************************/
/********************************************************************/
/**                                                                **/
/**                   FONCTIONS TRANSCENDANTES                     **/
/**                                                                **/
/**                      copyright Babe Cool                       **/
/**                                                                **/
/********************************************************************/
/********************************************************************/
/* $Id: trans1.c,v 2.0.0.2 1997/12/14 20:11:49 karim Exp karim $ */

# include "genpari.h"

#ifdef LONG_IS_64BIT
#  define C31 (9223372036854775808.0) /* 2^63   */
#else
#  define C31 (2147483648.0)          /* 2^31   */
#endif

/********************************************************************/
/**                                                                **/
/**                        FONCTION PI                             **/
/**                                                                **/
/********************************************************************/

void
constpi(long prec)
{
  GEN p1,p2,p3,tmppi,tokill;
  long l,n,n1,av1,av2;
  double alpha;

#define k1  545140134
#define k2  13591409
#define k3  640320
#define alpha2 (1.4722004/(BYTES_IN_LONG/4))  /* 3*log(k3/12)/(32*log(2)) */

  if (gpi && lg(gpi) >= prec) return;

  tokill = gpi; av1 = avma; tmppi = newbloc(prec);
  *tmppi = evaltyp(t_REAL) | evallg(prec);

  n=(long)(1+(prec-2)/alpha2);
  n1=6*n-1; p1=cgetr(prec);
  p2=addsi(k2,mulss(n,k1));
  affir(p2,p1);

  /* initialisation longueur mantisse */
  if (prec>=4) l=4; else l=prec;
  setlg(p1,l); alpha=l;

  av2 = avma;
  while (n)
  {
    if (n>1290)
    {
      if (n1>46340)
	p3 = divrs(divrs(mulsr(n1-4,mulsr(n1,mulsr(n1-2,p1))),n*n),n);
      else
	p3 = divrs(divrs(mulsr(n1-4,mulsr(n1*(n1-2),p1)),n*n),n);
    }
    else p3 = divrs(mulsr(n1-4,mulsr(n1*(n1-2),p1)),n*n*n);

    p3 = divrs(divrs(p3,100100025), 327843840);
    subisz(p2,k1,p2); subirz(p2,p3,p1);
    alpha += alpha2; l = (long)(1+alpha); /* nouvelle longueur mantisse */
    if (l>prec) l=prec;
    setlg(p1,l); avma = av2;
    n--; n1-=6;
  }

  p1 = divsr(53360,p1);
  mulrrz(p1,gsqrt(stoi(k3),prec), tmppi);
  killbloc(tokill); avma = av1;  gpi = tmppi;
}

GEN
mppi(long prec)
{
  GEN x = cgetr(prec);
  constpi(prec+1); affrr(gpi,x); return x;
}

/********************************************************************/
/**                                                                **/
/**                      FONCTION EULER                            **/
/**                                                                **/
/********************************************************************/

void
consteuler(long prec)
{
  GEN u,v,a,b,tmpeuler,tokill;
  long l,n,k,x,xx,av1,av2;

  if (geuler && lg(geuler) >= prec) return;

  tokill = geuler; av1 = avma; tmpeuler = newbloc(prec);
  *tmpeuler = evaltyp(t_REAL) | evallg(prec);

  l = prec+1; x = (long) (1 + (bit_accuracy(l) >> 2) * LOG2);
  a=cgetr(l); affsr(x,a); u=mplog(a); setsigne(u,-1); affrr(u,a);
  b=cgetr(l); affsr(1,b);
  v=cgetr(l); affsr(1,v); xx = x*x;
  n=(long)(1+3.591*x); /* a1=3.591: a1*[ ln(a1)-1 ]=1 */
  av2 = avma;
  for (k=1; k<=n; k++)
  {
    divrsz(mulsr(xx,b),k*k, b);
    divrsz(addrr(divrs(mulsr(xx,a),k),b),k, a);
    addrrz(u,a,u); addrrz(v,b,v); avma = av2;
  }
  divrrz(u,v,tmpeuler);
  killbloc(tokill); avma = av1; geuler = tmpeuler;
}

GEN
mpeuler(long prec)
{
  GEN x=cgetr(prec);
  consteuler(prec+1); affrr(geuler,x); return x;
}

/********************************************************************/
/**                                                                **/
/**       CONVERSION DE TYPES POUR FONCTIONS TRANSCENDANTES        **/
/**                                                                **/
/********************************************************************/

GEN
transc(GEN f(GEN,long), GEN x, long prec)
{
  GEN p1,p2,y;
  long lx,i,av,tetpil;

  av=avma;
  switch(typ(x))
  {
    case t_INT: case t_FRAC: case t_FRACN:
      p1=cgetr(prec); gaffect(x,p1); tetpil=avma;
      return gerepile(av,tetpil,f(p1,prec));

    case t_COMPLEX: case t_QUAD:
      av=avma; p1=cgetr(prec); affsr(1,p1);
      p1=gmul(x,p1); tetpil=avma;
      return gerepile(av,tetpil,f(p1,prec));

    case t_POL: case t_RFRAC: case t_RFRACN:
      p1=tayl(x,gvar(x),precdl); tetpil=avma;
      return gerepile(av,tetpil,f(p1,prec));

    case t_VEC: case t_COL: case t_MAT:
      lx=lg(x); y=cgetg(lx,typ(x));
      for (i=1; i<lx; i++)
	y[i] = (long) f((GEN)x[i],prec);
      return y;

    case t_POLMOD:
      av=avma; p1=roots((GEN)x[1],prec); lx=lg(p1); p2=cgetg(lx,t_COL);
      for (i=1; i<lx; i++) p2[i]=lpoleval((GEN)x[2],(GEN)p1[i]);
      tetpil=avma; y=cgetg(lx,t_COL);
      for (i=1; i<lx; i++)
        y[i] = (long)f((GEN)p2[i],prec);
      return gerepile(av,tetpil,y);

    case t_QFR: case t_QFI:
      err(talker,"quadratic forms cannot be used in transcendental functions");
  }
  return f(x,prec);
}

/********************************************************************/
/**                                                                **/
/**                        RACINE CARREE                           **/
/**                                                                **/
/********************************************************************/

GEN
mpsqrt(GEN x)
{
  long l,l0,l1,l2,s,eps,n,i,ex,av;
  double beta;
  GEN y,p1,p2,p3;

  if (typ(x)!=t_REAL) err(typeer,"mpsqrt");
  s=signe(x); if (s<0) err(talker,"negative argument in mpsqrt");
  if (!s)
  {
    y=cgetr(3); y[1]=HIGHEXPOBIT+(expo(x)>>1);
    y[2]=0; return y;
  }
  l=lg(x); y=cgetr(l); av=avma;
  
  p1=cgetr(l+1); affrr(x,p1);
  ex=expo(x); eps=ex % 2; ex /=2;
  if (eps<0) { eps+=2; ex-=1; }
  setexpo(p1,eps); setlg(p1,3);

  n=(long)(2+log((double) (l-2))/LOG2);
  p2=cgetr(l+1); p2[1]=evalexpo(0)+evalsigne(1);
  beta=sqrt((eps+1) * (2 + p1[2]/C31));
  p2[2]=(long)((beta-2)*C31);
  for (i=3; i<=l; i++) p2[i]=0;
  setlg(p2,3);

  if (!p2[2]) { p2[2]=HIGHBIT; setexpo(p2,1); }

  p3=cgetr(l+1); l-=2; l1=1; l2=3;
  for (i=1; i<=n; i++)
  {
    l0 = l1<<1;
    if (l0<=l)
      { l2 += l1; l1=l0; }
    else
      { l2 += l+1-l1; l1=l+1; }
    setlg(p3,l1+2); setlg(p1,l1+2); setlg(p2,l2);
    divrrz(p1,p2,p3); addrrz(p2,p3,p2); setexpo(p2,expo(p2)-1);
  }
  affrr(p2,y); setexpo(y,expo(y)+ex);
  avma=av; return y;
}

/* p = 2 */
static GEN
padic_sqrt2(GEN x, GEN y)
{
  long av,av2,l3,lp,lpp,pp,e;
  GEN p1,p2;

  pp = precp(x);
  e = mod8((GEN)x[4]);
  if (e!=1 && pp>=2)
    if (pp!=2 || e!=5) err(sqrter5);
  l3=lgefint(x[3]); y[4]=lgeti(l3); av=avma;

  affsi(1,(GEN)y[4]); lp=3;
  if (pp<=lp)
  {
    setprecp(y,1); y[3]=x[2];
    return y;
  }

  y[3]=lgeti(l3); av=avma;
  p2=gcopy(x); setvalp(p2,0); av2=avma;
  setvalp(y,0); affsi(8,(GEN)y[3]);
  while (lp<pp)
  {
    lpp=lp; lp=(lp<<1)-1;
    if (lp>=pp) { lp=pp; affii((GEN)x[3],(GEN)y[3]); }
    else mpshiftz((GEN)y[3],lpp-1,(GEN)y[3]);

    setprecp(y,lp); p1=gadd(y,gdiv(p2,y));
    gdivz(p1,gdeux,y);

    setprecp(y,lp-1); if (lp<pp) lp--;
    mpshiftz((GEN)y[3],-1,(GEN)y[3]);
    p1=subii((GEN)y[4],(GEN)y[3]);
    if (signe(p1)>=0) affii(p1,(GEN)y[4]);
    avma=av2;
  }
  avma=av; return y;
}

static GEN
padic_sqrt(GEN x)
{
  long av,av2,l3,e,lp,pp;
  GEN y,p1,p2;

  e=valp(x); y=cgetg(5,t_PADIC); y[2]=(long)copyifstack((GEN) x[2]);
  if (gcmp0(x))
  {
    y[4]=zero; e=(e+1)>>1;
    y[3]=lpuigs((GEN)x[2],e);
    setvalp(y,e); setprecp(y,precp(x));
    return y;
  }
  if (e & 1) err(sqrter6);
  e>>=1; setvalp(y,e);
  if (!cmpsi(2, (GEN)x[2])) return padic_sqrt2(x,y);

  /* p != 2 */
  pp = precp(x); l3 = lgefint(x[3]);
  y[4] = lgeti(l3); av=avma;
  p1 = mpsqrtmod((GEN)x[4],(GEN)x[2]);
  if (!p1) err(sqrter5);
  affii(p1,(GEN)y[4]); avma=av; lp=1;
  if (pp<=lp)
  {
    setprecp(y,1); y[3]=x[2];
    return y;
  }

  y[3]=lgeti(l3); av=avma;
  p2=gcopy(x); setvalp(p2,0); av2=avma;
  setvalp(y,0); affii((GEN)x[2],(GEN)y[3]);
  while (lp<pp)
  {
    lp<<=1;
    if (lp<pp) p1 = sqri((GEN)y[3]);
    else
      { lp=pp; p1 = (GEN)x[3]; }

    affii(p1,(GEN)y[3]); 
    setprecp(y,lp); p1=gadd(y,gdiv(p2,y));
    gdivz(p1,gdeux,y); avma=av2;
  }
  avma=av; return y;
}

GEN
gsqrt(GEN x, long prec)
{
  long av,tetpil,e;
  GEN y,p1,p2;

  switch(typ(x))
  {
    case t_REAL:
      if (signe(x)>=0) return mpsqrt(x);
      y=cgetg(3,t_COMPLEX); y[1]=zero;
      setsigne(x,1); y[2]=lmpsqrt(x); setsigne(x,-1);
      return y;

    case t_INTMOD:
      y=cgetg(3,t_INTMOD); y[1]=copyifstack(x[1]);
      p1 = mpsqrtmod((GEN)x[2],(GEN)y[1]);
      if (!p1) err(sqrter5);
      y[2] = (long)p1; return y;

    case t_COMPLEX:
      y=cgetg(3,t_COMPLEX); av=avma;
      if (gcmp0((GEN)x[2]))
      {
	long tx=typ(x[1]);

	if ((is_intreal_t(tx) || is_frac_t(tx)) && gsigne((GEN)x[1]) < 0)
	{
	  y[1]=zero; p1=gneg((GEN)x[1]); tetpil=avma;
	  y[2]=lpile(av,tetpil,gsqrt(p1,prec));
	  return y;
	}
	y[1]=lsqrt((GEN)x[1],prec);
	y[2]=zero; return y;
      }

      p1=gsqr((GEN)x[1]); p2=gsqr((GEN)x[2]);
      p1=gsqrt(gadd(p1,p2),prec);
      if (gcmp0(p1))
      {
	y[1]=lsqrt(p1,prec);
	y[2]=lcopy((GEN)y[1]);
	return y;
      }

      if (gsigne((GEN)x[1])<0)
      {
	p2=gsub(p1,(GEN)x[1]); p1=gmul2n(p2,-1);
	y[2]=lsqrt(p1,prec); y[1]=ldiv((GEN)x[2],gmul2n((GEN)y[2],1));
	tetpil=avma;
        y = (gsigne((GEN)x[2]) > 0)? gcopy(y): gneg(y);
	return gerepile(av,tetpil,y);
      }
     
      p1=gmul2n(gadd(p1,(GEN)x[1]),-1);
      tetpil=avma; y[1]=lpile(av,tetpil,gsqrt(p1,prec));
      av=avma; p1=gmul2n((GEN)y[1],1); tetpil=avma;
      y[2]=lpile(av,tetpil,gdiv((GEN)x[2],p1));
      return y;

    case t_PADIC:
      return padic_sqrt(x);

    case t_SER:
      e=valp(x);
      if (gcmp0(x))
      { 
	y=cgetg(3,t_SER); y[1]=HIGHVALPBIT+((e+1)>>1);
      }
      else
      {
	if (e & 1) err(sqrter6);
	setvalp(x,0); y = gpui(x,ghalf,prec); setvalp(x,e);
        e>>=1; setvalp(y,e);
      }
      setvarn(y,varn(x)); return y;
  }
  return transc(gsqrt,x,prec);
}

void
gsqrtz(GEN x, GEN y)
{
  long av=avma, prec = precision(y);

  if (!prec) err(infprecer,"gsqrtz");
  gaffect(gsqrt(x,prec),y); avma=av;
}

/********************************************************************/
/**                                                                **/
/**                    FONCTION EXPONENTIELLE-1                    **/
/**                                                                **/
/********************************************************************/

GEN
mpexp1(GEN x)
{
  long l,l1,l2,i,n,m,ex,s,av,av2, sx = signe(x);
  double a,b,alpha,beta, gama = 2.0 /* optimized for SUN3 */;
                                    /* KB: 3.0 is better for UltraSparc */
  GEN y,p1,p2,p3,p4,unr;

  if (typ(x)!=t_REAL) err(typeer,"mpexp1");
  if (!sx)
  {
    y=cgetr(3); y[1]=x[1]; y[2]=0; return y;
  }
  l=lg(x); y=cgetr(l); av=avma; /* room for result */

  l2 = l+1; ex = expo(x);
  alpha = -1-log(2+x[2]/C31)-ex*LOG2;
  beta = 5 + bit_accuracy(l)*LOG2;
  a = sqrt(beta/(gama*LOG2));
  b = (alpha + 0.5*log(beta*gama/LOG2))/LOG2;
  if (a>=b)
  {
    n=(long)(1+sqrt(beta*gama/LOG2));
    m=(long)(1+a-b);
    l2 += m>>TWOPOTBITS_IN_LONG;
  }
  else
  {
    n=(long)(1+beta/alpha);
    m=0;
  }
  unr=cgetr(l2); affsr(1,unr);
  p2=rcopy(unr); setlg(p2,4);
  p4=cgetr(l2); affrr(x,p4); setsigne(p4,1);
  if (m) setexpo(p4,ex-m);

  s=0; l1=4; av2 = avma;
  for (i=n; i>=2; i--)
  {
    setlg(p4,l1); p3 = divrs(p4,i);
    s -= expo(p3); p1 = mulrr(p3,p2); setlg(p1,l1);
    l1 += s>>TWOPOTBITS_IN_LONG; if (l1>l2) l1=l2;
    s %= BITS_IN_LONG;
    setlg(unr,l1); p1 = addrr(unr,p1);
    setlg(p2,l1); affrr(p1,p2); avma = av2;
  }
  setlg(p2,l2); setlg(p4,l2); p2 = mulrr(p4,p2);

  for (i=1; i<=m; i++)
  {
    setlg(p2,l2);
    p2 = mulrr(addsr(2,p2),p2);
  }
  if (sx == -1)
  { 
    setlg(unr,l2); p2 = addrr(unr,p2);
    setlg(p2,l2); p2 = ginv(p2);
    p2 = subrr(p2,unr);
  }
  affrr(p2,y); avma = av; return y;
}

/********************************************************************/
/**                                                                **/
/**                   FONCTION EXPONENTIELLE                       **/
/**                                                                **/
/********************************************************************/

GEN
mpexp(GEN x)
{
  long av, sx = signe(x);
  GEN y;

  if (!sx) return addsr(1,x);
  if (sx<0) setsigne(x,1);
  av = avma; y = addsr(1, mpexp1(x));
  if (sx<0) { y = divsr(1,y); setsigne(x,-1); }
  return gerepileupto(av,y);
}

static GEN
paexp(GEN x)
{
  long k,av, e = valp(x), pp = precp(x), n = e + pp;
  GEN y,r,p1;

  if (gcmp0(x)) return gaddgs(x,1);
  if (e<=0 || (!cmpis((GEN)x[2],2) && e==1))
    err(talker,"p-adic argument out of range in gexp");
  av = avma;
  if (cmpsi(2,(GEN)x[2]))
  {
    p1 = subis((GEN)x[2], 1);
    k = itos(dvmdii(subis(mulis(p1,n), 1), subis(mulis(p1,e), 1), &r));
    if (!signe(r)) k--;
  }
  else
  {
    n--; e--; k = n/e;
    if (n%e==0) k--;
  }
  for (y=gun; k; k--) y = gaddsg(1, gdivgs(gmul(y,x), k));
  return gerepileupto(av, y);
}

GEN
gexp(GEN x, long prec)
{
  long av,tetpil,ex;
  GEN r,y,p1,p2;

  switch(typ(x))
  {
    case t_REAL:
      return mpexp(x);

    case t_COMPLEX:
      y=cgetg(3,t_COMPLEX); av=avma;
      r=gexp((GEN)x[1],prec);
      gsincos((GEN)x[2],&p2,&p1,prec);
      tetpil=avma;
      y[1]=lmul(r,p1); y[2]=lmul(r,p2);
      gerepilemanyvec(av,tetpil,y+1,2);
      return y;

    case t_PADIC:
      return paexp(x); 

    case t_SER:
      if (gcmp0(x)) return gaddsg(1,x);

      ex=valp(x); if (ex<0) err(negexper,"gexp");
      if (ex)
      {
	long i,j,ly=lg(x)+ex;

	y=cgetg(ly,t_SER);
	y[1]=evalsigne(1)+HIGHVALPBIT; y[2]=un; setvarn(y,varn(x));
	for (i=3; i<ex+2; i++) y[i]=zero;
	for (i=ex+2; i<ly; i++)
	{
	  av=avma; p1=gzero;
	  for (j=ex; j<i-1; j++)
	    p1=gadd(p1,gmulgs(gmul((GEN)x[j-ex+2],(GEN)y[i-j]),j));
	  tetpil=avma; y[i]=lpile(av,tetpil,gdivgs(p1,i-2));
	}
	return y;
      }
      av=avma; p1=gcopy(x); p1[2]=zero;
      p2=gexp(normalize(p1),prec);
      p1=gexp((GEN)x[2],prec); tetpil=avma;
      return gerepile(av,tetpil,gmul(p1,p2));

    case t_INTMOD:
      err(typeer,"gexp");
  }
  return transc(gexp,x,prec);
}

void
gexpz(GEN x, GEN y)
{
  long av=avma, prec = precision(y);

  if (!prec) err(infprecer,"gexpz");
  gaffect(gexp(x,prec),y); avma=av;
}

/********************************************************************/
/**                                                                **/
/**                      FONCTION LOGARITHME                       **/
/**                                                                **/
/********************************************************************/

GEN
mplog(GEN x)
{
  long l,l1,l2,m,m1,n,i,ex,s,sgn,ltop,av;
  double alpha,beta,a,b;
  GEN y,p1,p2,p3,p4,p5,unr;

  if (typ(x)!=t_REAL) err(typeer,"mplog");
  if (signe(x)<=0) err(talker,"non positive argument in mplog");
  l=lg(x); sgn = cmpsr(1,x); if (!sgn) return realzero(l);
  y=cgetr(l); ltop=avma;

  l2 = l+1; p2=p1=cgetr(l2); affrr(x,p1);
  av=avma;
  if (sgn > 0) p2 = divsr(1,p1); /* x<1 changer x en 1/x */
  for (m1=1; expo(p2)>0; m1++) p2 = mpsqrt(p2);
  if (m1 > 1 || sgn > 0) { affrr(p2,p1); avma=av; }

  alpha = 1+p1[2]/C31; if (!alpha) alpha = 0.00000001;
  l -= 2; alpha = -log(alpha);
  beta = (BITS_IN_LONG/2)*l*LOG2;
  a = alpha/LOG2;
  b = sqrt((BITS_IN_LONG/2)*l/3.0);
  if (a<=b)
  {
    n=(long)(1+sqrt((BITS_IN_LONG/2)*3.0*l));
    m=(long)(1+b-a);
    l2 += m>>TWOPOTBITS_IN_LONG;
    p4=cgetr(l2); affrr(p1,p4);
    p1 = p4; av=avma;
    for (i=1; i<=m; i++)  p1 = mpsqrt(p1);
    affrr(p1,p4); avma=av;
  }
  else
  {
    n=(long)(1+beta/alpha);
    m=0; p4 = p1;
  }
  unr=cgetr(l2); affsr(1,unr);
  p2=cgetr(l2); p3=cgetr(l2); av=avma;

  /* affrr needed here instead of setlg since prec may DECREASE */
  p1 = cgetr(l2); affrr(subrr(p4,unr), p1);

  p5 = addrr(p4,unr); setlg(p5,l2);
  affrr(divrr(p1,p5), p2); 
  affrr(mulrr(p2,p2), p3);
  affrr(divrs(unr,2*n+1), p4); setlg(p4,4); avma=av;

  s=0; ex=expo(p3); l1 = 4;
  for (i=n; i>=1; i--)
  {
    setlg(p3,l1); p5 = mulrr(p4,p3);
    setlg(unr,l1); p1 = divrs(unr,2*i-1);
    s -= ex; 
    l1 += s>>TWOPOTBITS_IN_LONG; if (l1>l2) l1=l2;
    s %= BITS_IN_LONG;
    setlg(p1,l1); setlg(p4,l1); setlg(p5,l1);
    p1 = addrr(p1,p5); affrr(p1,p4); avma=av;
  }
  setlg(p4,l2); affrr(mulrr(p2,p4), y);
  setexpo(y, expo(y)+m+m1);
  if (sgn > 0) setsigne(y, -1);
  avma=ltop; return y;
}

GEN
teich(GEN x)
{
  GEN aux,y,z,p1;
  long av,n,k;

  if (typ(x)!=t_PADIC) err(talker,"not a p-adic argument in teichmuller");
  if (!signe(x[4])) return gcopy(x);
  y=cgetp(x); setvalp(y,0); z=(GEN)x[4];
  if (!cmpis((GEN)x[2],2))
  {
    n = mod4(z);
    if (n & 2)
      addsiz(-1,(GEN)x[3],(GEN)y[4]);
    else
      affsi(1,(GEN)y[4]);
    return y;
  }
  av = avma; p1 = addsi(-1,(GEN)x[2]);
  aux = divii(addsi(-1,(GEN)x[3]),p1); n = precp(x);
  for (k=1; k<n; k<<=1)
    z=modii(mulii(z,addsi(1,mulii(aux,addsi(-1,puissmodulo(z,p1,(GEN)x[3]))))),
            (GEN)x[3]);
  affii(z,(GEN)y[4]); avma=av; return y;
}

static GEN
palogaux(GEN x)
{
  long av1=avma,tetpil,k,e,pp;
  GEN y,s,y2;

  if (!cmpsi(1,(GEN)x[4]))
  {
    y=gaddgs(x,-1);
    if (!cmpsi(2,(GEN)x[2]))
    {
      setvalp(y,valp(y)-1);
      if (!gcmp1((GEN)y[3])) y[3]=lshifti((GEN)y[3],-1);
    }
    tetpil=avma; return gerepile(av1,tetpil,gcopy(y));
  }
  y=gdiv(gaddgs(x,-1),gaddgs(x,1)); e=valp(y); pp=e+precp(y);
  if (cmpsi(2,(GEN)x[2]))
  {
    long av=avma;
    GEN p1;

    for (p1=stoi(e); cmpsi(pp,p1)>0; pp++)
      p1 = mulii(p1,(GEN)x[2]);
    avma=av; pp-=2;
  }
  else pp--;
  k=pp/e; if (!odd(k)) k--;
  y2=gsqr(y); s=gdivgs(gun,k);
  while (k>=3)
  {
    k-=2; s=gadd(gmul(y2,s),gdivgs(gun,k));
  }
  tetpil=avma; return gerepile(av1,tetpil,gmul(s,y));
}

GEN
palog(GEN x)
{
  long av=avma,tetpil;
  GEN p1,y;

  if (!signe(x[4])) err(talker,"zero argument in palog");
  if (cmpis((GEN)x[2],2))
  {
    y=cgetp(x); setvalp(y,0);
    p1=gsubgs((GEN)x[2],1);
    affii(puissmodulo((GEN)x[4],p1,(GEN)x[3]),(GEN)y[4]);
    y=gmulgs(palogaux(y),2); tetpil=avma;
    return gerepile(av,tetpil,gdiv(y,p1));
  }
  y=gsqr(x); setvalp(y,0); tetpil=avma;
  return gerepile(av,tetpil,palogaux(y));
}

GEN
log0(GEN x, long flag,long prec)
{
  switch(flag)
  {
    case 0: return glog(x,prec);
    case 1: return glogagm(x,prec);
    default: err(flagerr);
  }
  return NULL; /* not reached */
}

GEN
glog(GEN x, long prec)
{
  long av,tetpil,v;
  GEN y,p1,p2;

  switch(typ(x))
  {
    case t_REAL:
      if (signe(x)>=0) return mplog(x);
      y=cgetg(3,t_COMPLEX); y[2]=lmppi(lg(x));
      setsigne(x,1); y[1]=lmplog(x);
      setsigne(x,-1); return y;

    case t_COMPLEX:
      y=cgetg(3,t_COMPLEX); y[2]=larg(x,prec);
      av=avma; p1=glog(gnorm(x),prec); tetpil=avma;
      y[1]=lpile(av,tetpil,gmul2n(p1,-1));
      return y;

    case t_PADIC:
      return palog(x);

    case t_SER:
      av=avma; if (valp(x)) err(negexper,"glog");
      v=varn(x); p1=gdiv(deriv(x,v),x);
      tetpil=avma; p1=integ(p1,v); 
      if (gcmp1((GEN)x[2])) return gerepile(av,tetpil,p1);

      p2=glog((GEN)x[2],prec); tetpil=avma;
      return gerepile(av,tetpil,gadd(p1,p2));

    case t_INTMOD:
      err(typeer,"glog");
  }
  return transc(glog,x,prec);
}

void
glogz(GEN x, GEN y)
{
  long av=avma, prec = precision(y);

  if (!prec) err(infprecer,"glogz");
  gaffect(glog(x,prec),y); avma=av;
}

/********************************************************************/
/**                                                                **/
/**                      FONCTION SINCOS-1                         **/
/**                                                                **/
/********************************************************************/

static GEN
mpsc1(GEN x, long *ptmod8)
{
  const long mmax = 23169;
 /* on a 64-bit machine with true 128 bit/64 bit division, one could
  * take mmax=1518500248; on the alpha it does not seem worthwhile
  */
  long l,l0,l1,l2,l4,ee,i,n,m,s,t,av;
  double alpha,beta,a,b,c,d;
  GEN y,p1,p2,p3,p4,pitemp;

  if (typ(x)!=t_REAL) err(typeer,"mpsc1");
  if (!signe(x))
  {
    *ptmod8=0; y=cgetr(3); y[2]=0; y[1]=HIGHEXPOBIT-1+(expo(x)<<1);
    return y;
  }
  l=lg(x); y=cgetr(l); av=avma; 

  l++; pitemp = mppi(l+1); setexpo(pitemp,-1);
  p1 = addrr(x,pitemp); setexpo(pitemp,0);
  if (expo(p1) >= bit_accuracy(l) + 3)
    err(talker,"loss of precision in mpsc1");
  p3 = divrr(p1,pitemp); p2 = mpent(p3);
  if (signe(p2)) x = subrr(x, mulir(p2,pitemp));
  p1 = cgetr(l+1); affrr(x, p1);

  *ptmod8 = (signe(p1) < 0)? 4: 0;
  if (signe(p2))
  {
    long mod4 = mod4(p2);
    if (signe(p2) < 0 && mod4) mod4 = 4-mod4;
    *ptmod8 += mod4;
  }
  if (gcmp0(p1)) alpha=1000000.0;
  else
  { 
    m=expo(p1); alpha=(m<-1023)? -1-m*LOG2: -1-log(fabs(rtodbl(p1)));
  }
  beta = 5 + bit_accuracy(l)*LOG2;
  a=0.5/LOG2; b=0.5*a;
  c = a+sqrt((beta+b)/LOG2);
  d = ((beta/c)-alpha-log(c))/LOG2;
  if (d>=0)
  { 
    m=(long)(1+d);
    n=(long)((1+c)/2.0);
    setexpo(p1,expo(p1)-m);
  }
  else { m=0; n=(long)((1+beta/alpha)/2.0); }
  l2=l+1+(m>>TWOPOTBITS_IN_LONG);
  p2=cgetr(l2); affsr(1,p2); setlg(p2,4);
  p4=cgetr(l2); av = avma;
  affrr(mulrr(p1,p1),p4); setlg(p4,4);

  if (n>mmax)
    p3 = divrs(divrs(p4,2*n+2),2*n+1);
  else
    p3 = divrs(p4, (2*n+2)*(2*n+1));
  ee = -expo(p3); s=0;
  l4 = l1 = 3 + (ee>>TWOPOTBITS_IN_LONG);
  if (l4<=l2) { setlg(p2,l4); setlg(p4,l4); }
  for (i=n; i>mmax; i--)
  {
    p3 = divrs(divrs(p4,2*i),2*i-1); s -= expo(p3);
    t=s&(BITS_IN_LONG-1); l0=(s>>TWOPOTBITS_IN_LONG);
    if (t) l0++;
    l1 += l0; if (l1>l2) { l0 += l2-l1; l1=l2; }
    l4 += l0;
    p3 = mulrr(p3,p2);
    if (l4<=l2) { setlg(p2,l4); setlg(p4,l4); }
    subsrz(1,p3,p2); avma=av;
  }
  for (  ; i>=2; i--)
  {
    p3 = divrs(p4, 2*i*(2*i-1)); s -= expo(p3);
    t=s&(BITS_IN_LONG-1); l0=(s>>TWOPOTBITS_IN_LONG);
    if (t) l0++;
    l1 += l0; if (l1>l2) { l0 += l2-l1; l1=l2; }
    l4 += l0;
    p3 = mulrr(p3,p2);
    if (l4<=l2) { setlg(p2,l4); setlg(p4,l4); }
    subsrz(1,p3,p2); avma=av;
  }
  if (l4<=l2) { setlg(p2,l4); setlg(p4,l4); }
  setexpo(p4,expo(p4)-1); setsigne(p4, -signe(p4));
  p2 = mulrr(p4,p2);
  for (i=1; i<=m; i++)
  {
    p2 = mulrr(p2,addsr(2,p2)); setexpo(p2,expo(p2)+1);
  }
  affrr(p2,y); avma=av; return y;
}

/********************************************************************/
/**                                                                **/
/**                      FONCTION sqrt(-x*(x+2))                   **/
/**                                                                **/
/********************************************************************/

static GEN
mpaut(GEN x)
{
  long av = avma;
  GEN p1;

  cgetr(2*lg(x)+3); /* bound for 2*lg(p1)+1 */
  p1=mulrr(x,addsr(2,x)); setsigne(p1,-signe(p1));
  avma = av; return mpsqrt(p1); /* safe ! */
}

/********************************************************************/
/**                                                                **/
/**                       FONCTION COSINUS                         **/
/**                                                                **/
/********************************************************************/

static GEN
mpcos(GEN x)
{
  long mod8,av,tetpil;
  GEN y,p1;

  if (typ(x)!=t_REAL) err(typeer,"mpcos");
  if (!signe(x)) return addsr(1,x);

  av=avma; p1=mpsc1(x,&mod8); tetpil=avma;
  switch(mod8)
  {
    case 0: case 4:
      y=addsr(1,p1); break;
    case 1: case 7:
      y=mpaut(p1); setsigne(y,-signe(y)); break;
    case 2: case 6:
      y=subsr(-1,p1); break;
    case 3: case 5:
      y=mpaut(p1); break;
    default:;
  }
  return gerepile(av,tetpil,y);
}

GEN
gcos(GEN x, long prec)
{
  long av,tetpil;
  GEN r,u,v,y,p1,p2;

  switch(typ(x))
  {
    case t_REAL:
      return mpcos(x);

    case t_COMPLEX:
      y=cgetg(3,t_COMPLEX); av=avma;
      r=gexp((GEN)x[2],prec); p1=ginv(r);
      p2=gmul2n(mpadd(p1,r),-1);
      p1=mpsub(p2,r);
      gsincos((GEN)x[1],&u,&v,prec);
      tetpil=avma;
      y[1]=lmul(p2,v); y[2]=lmul(p1,u);
      gerepilemanyvec(av,tetpil,y+1,2);
      return y;

    case t_SER:
      if (gcmp0(x)) return gaddsg(1,x);
      if (valp(x)<0) err(negexper,"gcos");

      av=avma; gsincos(x,&u,&v,prec); tetpil=avma;
      return gerepile(av,tetpil,gcopy(v));

    case t_INTMOD: case t_PADIC:
      err(typeer,"gcos");
  }
  return transc(gcos,x,prec);
}

void
gcosz(GEN x, GEN y)
{
  long av = avma, prec = precision(y);

  if (!prec) err(infprecer,"gcosz");
  gaffect(gcos(x,prec),y); avma=av;
}

/********************************************************************/
/**                                                                **/
/**                       FONCTION SINUS                           **/
/**                                                                **/
/********************************************************************/

GEN
mpsin(GEN x)
{
  long mod8,av,tetpil;
  GEN y,p1;

  if (typ(x)!=t_REAL) err(typeer,"mpsin");
  if (!signe(x))
  {
    y=cgetr(3); y[1]=x[1]; y[2]=0;
    return y;
  }

  av=avma; p1=mpsc1(x,&mod8); tetpil=avma;
  switch(mod8)
  {
    case 0: case 6:
      y=mpaut(p1); break;
    case 1: case 5:
      y=addsr(1,p1); break;
    case 2: case 4:
      y=mpaut(p1); setsigne(y,-signe(y)); break;
    case 3: case 7:
      y=subsr(-1,p1); break;
    default:;
  }
  return gerepile(av,tetpil,y);
}

GEN
gsin(GEN x, long prec)
{
  long av,tetpil;
  GEN r,u,v,y,p1,p2;

  switch(typ(x))
  {
    case t_REAL:
      return mpsin(x);

    case t_COMPLEX:
      y=cgetg(3,t_COMPLEX); av=avma;
      r=gexp((GEN)x[2],prec); p1=ginv(r);
      p2=gmul2n(mpadd(p1,r),-1);
      p1=mpsub(p2,p1);
      gsincos((GEN)x[1],&u,&v,prec);
      tetpil=avma;
      y[1]=lmul(p2,u); y[2]=lmul(p1,v);
      gerepilemanyvec(av,tetpil,y+1,2);
      return y;

    case t_SER:
      if (gcmp0(x)) return gcopy(x);
      if (valp(x)<0) err(negexper,"gsin");

      av=avma; gsincos(x,&u,&v,prec); tetpil=avma;
      return gerepile(av,tetpil,gcopy(u));

    case t_INTMOD: case t_PADIC:
      err(typeer,"gsin");
  }
  return transc(gsin,x,prec);
}

void
gsinz(GEN x, GEN y)
{
  long av=avma, prec = precision(y);

  if (!prec) err(infprecer,"gsinz");
  gaffect(gsin(x,prec),y); avma=av;
}

/********************************************************************/
/**                                                                **/
/**                    PROCEDURE SINUS,COSINUS                     **/
/**                                                                **/
/********************************************************************/

static void
mpsincos(GEN x, GEN *s, GEN *c)
{
  long av,tetpil,mod8;
  GEN p1, *gptr[2];

  if (typ(x)!=t_REAL) err(typeer,"mpsincos");
  if (!signe(x))
  {
    p1=cgetr(3); *s=p1; p1[1]=x[1];
    p1[2]=0; *c=addsr(1,x); return;
  }

  av=avma; p1=mpsc1(x,&mod8); tetpil=avma;
  switch(mod8)
  {
    case 0: *c=addsr( 1,p1); *s=mpaut(p1); break;
    case 1: *s=addsr( 1,p1); *c=mpaut(p1); setsigne(*c,-signe(*c)); break;
    case 2: *c=subsr(-1,p1); *s=mpaut(p1); setsigne(*s,-signe(*s)); break;
    case 3: *s=subsr(-1,p1); *c=mpaut(p1); break;
    case 4: *c=addsr( 1,p1); *s=mpaut(p1); setsigne(*s,-signe(*s)); break;
    case 5: *s=addsr( 1,p1); *c=mpaut(p1); break;
    case 6: *c=subsr(-1,p1); *s=mpaut(p1); break;
    case 7: *s=subsr(-1,p1); *c=mpaut(p1); setsigne(*c,-signe(*c)); break;
  }
  gptr[0]=s; gptr[1]=c;
  gerepilemanysp(av,tetpil,gptr,2);
}

void
gsincos(GEN x, GEN *s, GEN *c, long prec)
{
  long av,tetpil,ii,i,j,ex,ex2,lx,ly;
  GEN r,u,v,u1,v1,p1,p2,p3,p4,ps,pc;
  GEN *gptr[4];

  switch(typ(x))
  {
    case t_INT: case t_FRAC: case t_FRACN:
      av=avma; p1=cgetr(prec); gaffect(x,p1); tetpil=avma;
      mpsincos(p1,s,c); gptr[0]=s; gptr[1]=c;
      gerepilemanysp(av,tetpil,gptr,2);
      return;

    case t_REAL:
      mpsincos(x,s,c); return;

    case t_COMPLEX:
      ps=cgetg(3,t_COMPLEX); pc=cgetg(3,t_COMPLEX);
      *s=ps; *c=pc; av=avma;
      r=gexp((GEN)x[2],prec); p1=ginv(r);
      p2=gmul2n(mpadd(p1,r),-1);
      p1=mpsub(p2,p1); r=mpsub(p2,r);
      gsincos((GEN)x[1],&u,&v,prec);
      tetpil=avma;
      p1=gmul(p2,u); p2=gmul(p1,v);
      p3=gmul(p2,v); p4=gmul(r,u);
      gptr[0]=&p1; gptr[1]=&p2; gptr[2]=&p3; gptr[3]=&p4;
      gerepilemanysp(av,tetpil,gptr,4);
      ps[1]=(long)p1; ps[2]=(long)p2; pc[1]=(long)p3; pc[2]=(long)p4;
      return;

    case t_SER:
      if (gcmp0(x)) { *c=gaddsg(1,x); *s=gcopy(x); return; }

      ex=valp(x); lx=lg(x); ex2=2*ex+2;
      if (ex < 0) err(talker,"non zero exponent in gsincos");
      if (ex2 > lx)
      {
        *s=gcopy(x); av=avma; p1=gdivgs(gsqr(x),2);
        tetpil=avma; *c=gerepile(av,tetpil,gsubsg(1,p1));
	return;
      }
      if (!ex)
      {
        av=avma; p1=gcopy(x); p1[2]=zero;
        gsincos(normalize(p1),&u,&v,prec);
        gsincos((GEN)x[2],&u1,&v1,prec);
        p1=gmul(v1,v); p2=gmul(u1,u); p3=gmul(v1,u);
        p4=gmul(u1,v); tetpil=avma;
        *c=gsub(p1,p2); *s=gadd(p3,p4);
	gptr[0]=s; gptr[1]=c;
	gerepilemanysp(av,tetpil,gptr,2);
	return;
      }

      ly=lx+2*ex;
      pc=cgetg(ly,t_SER); ps=cgetg(lx,t_SER);
      *c=pc; *s=ps; pc[1]=evalsigne(1)+HIGHVALPBIT; setvarn(pc,varn(x));
      pc[2]=un; ps[1]=x[1];
      for (i=2; i<ex+2; i++) ps[i]=lcopy((GEN)x[i]);
      for (i=3; i<ex2; i++) pc[i]=zero;
      for (i=ex2; i<ly; i++)
      {
	ii=i-ex; av=avma; p1=gzero;
	for (j=ex; j<ii-1; j++)
	  p1=gadd(p1,gmulgs(gmul((GEN)x[j-ex+2],(GEN)ps[ii-j]),j));
	tetpil=avma;
	pc[i]=lpile(av,tetpil,gdivgs(p1,2-i));
	if (ii<lx)
	{
	  av=avma; p1=gzero;
	  for (j=ex; j<=i-ex2; j++)
	    p1=gadd(p1,gmulgs(gmul((GEN)x[j-ex+2],(GEN)pc[i-j]),j));
	  p1=gdivgs(p1,i-2); tetpil=avma;
	  ps[i-ex]=lpile(av,tetpil,gadd(p1,(GEN)x[i-ex]));
	}
      }
      return;
  }
  err(typeer,"gsincos");
}

/********************************************************************/
/**                                                                **/
/**                      FONCTION TANGENTE                         **/
/**                                                                **/
/********************************************************************/

static GEN
mptan(GEN x)
{
  long av=avma,tetpil;
  GEN s,c;

  mpsincos(x,&s,&c); tetpil=avma;
  return gerepile(av,tetpil,divrr(s,c));
}

GEN
gtan(GEN x, long prec)
{
  long av,tetpil;
  GEN s,c;

  switch(typ(x))
  {
    case t_REAL:
      return mptan(x);

    case t_SER:
      if (gcmp0(x)) return gcopy(x);
      if (valp(x)<0) err(negexper,"gtan"); /* fall through */
    case t_COMPLEX:
      av=avma; gsincos(x,&s,&c,prec); tetpil=avma;
      return gerepile(av,tetpil,gdiv(s,c));

    case t_INTMOD: case t_PADIC:
      err(typeer,"gtan");
  }
  return transc(gtan,x,prec);
}

void
gtanz(GEN x, GEN y)
{
  long av=avma, prec = precision(y);

  if (!prec) err(infprecer,"gtanz");
  gaffect(gtan(x,prec),y); avma=av;
}
