/* Copyright (C) 2000  The PARI group.

This file is part of the PARI/GP package.

PARI/GP is free software; you can redistribute it and/or modify it under the
terms of the GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version. It is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY WHATSOEVER.

Check the License for details. You should have received a copy of it, along
with the package; see the file 'COPYING'. If not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */

#include "pari.h"
#include "paripriv.h"

#define DEBUGLEVEL DEBUGLEVEL_subcyclo

/*************************************************************************/
/**                                                                     **/
/**              Routines for handling subgroups of (Z/nZ)^*            **/
/**              without requiring discrete logarithms.                 **/
/**                                                                     **/
/*************************************************************************/
/* Subgroups are [gen,ord,bits] where
 * gen is a vecsmall of generators
 * ord is theirs relative orders
 * bits is a bit vector of the elements, of length(n). */

/*The algorithm is similar to testpermutation*/
static void
znstar_partial_coset_func(long n, GEN H, void (*func)(void *data,long c),
  void *data, long d, long c)
{
  GEN gen, ord, cache;
  long i, j, card;

  if (!d) { (*func)(data,c); return; }

  cache = const_vecsmall(d,c);
  (*func)(data,c);  /* AFTER cache: may contain gc_upto statement */
  gen = gel(H,1);
  ord = gel(H,2);
  card = ord[1]; for (i = 2; i <= d; i++) card *= ord[i];
  for(i=1; i<card; i++)
  {
    long k, m = i;
    for(j=1; j<d && m%ord[j]==0 ;j++) m /= ord[j];
    cache[j] = Fl_mul(cache[j],gen[j],n);
    for (k=1; k<j; k++) cache[k] = cache[j];
    (*func)(data, cache[j]);
  }
}

static void
znstar_coset_func(long n, GEN H, void (*func)(void *data,long c),
  void *data, long c)
{ znstar_partial_coset_func(n, H, func,data, lg(gel(H,1))-1, c); }

/* Add the element of the bitvec of the coset c modulo the subgroup of H
 * generated by the first d generators to the bitvec bits.*/

static void
znstar_partial_coset_bits_inplace(long n, GEN H, GEN bits, long d, long c)
{
  pari_sp av = avma;
  znstar_partial_coset_func(n,H, (void (*)(void *,long)) &F2v_set,
      (void *) bits, d, c);
  set_avma(av);
}

static void
znstar_coset_bits_inplace(long n, GEN H, GEN bits, long c)
{ znstar_partial_coset_bits_inplace(n, H, bits, lg(gel(H,1))-1, c); }

static GEN
znstar_partial_coset_bits(long n, GEN H, long d, long c)
{
  GEN bits = zero_F2v(n);
  znstar_partial_coset_bits_inplace(n,H,bits,d,c);
  return bits;
}

/* Compute the bitvec of the elements of the subgroup of H generated by the
 * first d generators.*/
static GEN
znstar_partial_bits(long n, GEN H, long d)
{ return znstar_partial_coset_bits(n, H, d, 1); }

/* Compute the bitvec of the elements of H. */
GEN
znstar_bits(long n, GEN H)
{ return znstar_partial_bits(n,H,lg(gel(H,1))-1); }

/* Compute the subgroup of (Z/nZ)^* generated by the elements of
 * the vecsmall V */
GEN
znstar_generate(long n, GEN V)
{
  pari_sp av = avma;
  GEN gen = cgetg(lg(V),t_VECSMALL);
  GEN ord = cgetg(lg(V),t_VECSMALL), res = mkvec2(gen,ord);
  GEN bits = znstar_partial_bits(n,NULL,0);
  long i, r = 0;
  for(i=1; i<lg(V); i++)
  {
    ulong v = uel(V,i), g = v;
    long o = 0;
    while (!F2v_coeff(bits, (long)g)) { g = Fl_mul(g, v, (ulong)n); o++; }
    if (!o) continue;
    r++;
    gen[r] = v;
    ord[r] = o+1;
    cgiv(bits); bits = znstar_partial_bits(n,res,r);
  }
  setlg(gen,r+1);
  setlg(ord,r+1); return gc_GEN(av, mkvec3(gen,ord,bits));
}

static ulong
znstar_order(GEN H) { return zv_prod(gel(H,2)); }

/* Return the lists of element of H.
 * This can be implemented with znstar_coset_func instead. */
GEN
znstar_elts(long n, GEN H)
{
  long card = znstar_order(H);
  GEN gen = gel(H,1), ord = gel(H,2);
  GEN sg = cgetg(1 + card, t_VECSMALL);
  long k, j, l;
  sg[1] = 1;
  for (j = 1, l = 1; j < lg(gen); j++)
  {
    long c = l * (ord[j]-1);
    for (k = 1; k <= c; k++) sg[++l] = Fl_mul(sg[k], gen[j], n);
  }
  vecsmall_sort(sg); return sg;
}

/* Take a znstar H and n dividing the modulus of H.
 * Output H reduced to modulus n */
GEN
znstar_reduce_modulus(GEN H, long n)
{
  pari_sp ltop=avma;
  GEN gen=cgetg(lgcols(H),t_VECSMALL);
  long i;
  for(i=1; i < lg(gen); i++)
    gen[i] = mael(H,1,i)%n;
  return gc_upto(ltop, znstar_generate(n,gen));
}

/* Compute conductor of H, bits = H[3] */
long
znstar_conductor_bits(GEN bits)
{
  pari_sp av = avma;
  long i, f = 1, cnd0 = bits[1];
  GEN F = factoru(cnd0), P = gel(F,1), E = gel(F,2);
  for (i = lg(P)-1; i > 0; i--)
  {
    long p = P[i], e = E[i], cnd = cnd0;
    for (  ; e >= 2; e--)
    {
      long q = cnd / p;
      if (!F2v_coeff(bits, 1 + q)) break;
      cnd = q;
    }
    if (e == 1)
    {
      if (p == 2) e = 0;
      else
      {
        long h, g = pgener_Fl(p), q = cnd / p;
        h = Fl_mul(g-1, Fl_inv(q % p, p), p); /* 1+h*q = g (mod p) */
        if (F2v_coeff(bits, 1 + h*q)) e = 0;
      }
    }
    if (e) f *= upowuu(p, e);
  }
  return gc_long(av,f);
}
long
znstar_conductor(GEN H) { return znstar_conductor_bits(gel(H,3)); }

/* Compute the orbits of a subgroups of Z/nZ given by a generator
 * or a set of generators given as a vector.
 */
GEN
znstar_cosets(long n, long phi_n, GEN H)
{
  long k, c = 0, card = znstar_order(H), index = phi_n/card;
  GEN cosets = cgetg(index+1,t_VECSMALL);
  pari_sp ltop = avma;
  GEN bits = zero_F2v(n);
  for (k = 1; k <= index; k++)
  {
    for (c++ ; F2v_coeff(bits,c) || ugcd(c,n)!=1; c++);
    cosets[k]=c;
    znstar_coset_bits_inplace(n, H, bits, c);
  }
  set_avma(ltop); return cosets;
}

static GEN
znstar_quotient(long n, long phi_n, GEN H, GEN R, ulong l)
{
  long i, j, k, c = 0, card   = znstar_order(H), index  = phi_n/card;
  GEN cosets = cgetg(index+1,t_VECSMALL), mult = cgetg(index+1, t_VEC);
  GEN bits = zero_F2v(n), vbits= zero_F2m_copy(n,index);
  for (k = 1; k <= index; k++)
  {
    for (c++ ; F2v_coeff(bits,c) || ugcd(c,n)!=1; c++);
    cosets[k]=c;
    znstar_coset_bits_inplace(n, H, gel(vbits,k), c);
    F2v_add_inplace(bits, gel(vbits,k));
  }

  for (k = 1; k <= index; k++)
  {
    GEN v = cgetg(index+1, t_VECSMALL);
    for (j = 1; j <= index; j++)
    {
      long s = Fl_mul(cosets[k],cosets[j],n);
      for (i = 1; i <= index; i++)
        if (F2v_coeff(gel(vbits,i),s)) break;
      v[j] = R[i];
    }
    gel(mult,k) = v;
  }
  return Flv_Flm_polint(R, mult, l, 0);
}

/* return n s.t. x^n in H */
static ulong
order_H_x(GEN H, ulong x, GEN D, ulong *xn)
{
  ulong i, l = lg(D), f = H[1], y = x; /* = x^D[1] */
  *xn = x; if (F2v_coeff(H, y)) return D[1];
  for (i = 2; i < l; i++)
  { /* TODO: could cache the x^delta[i] incrementally */
    y = Fl_mul(y, Fl_powu(x, D[i]-D[i-1], f), f);
    if (F2v_coeff(H, y))
    {
      if (xn) *xn = y;
      return D[i];
    }
  }
  pari_err_BUG("znsubgroupgenerators [order_H_x]");
  return 0;/*LCOV_EXCL_LINE*/
}
/* If H2 = (0), return 0. Else find an x in H2 of maximal order o in H2/H1;
 * if flag is set, make sure that x has also order o in (Z/fZ)^* */
static ulong
max_order_ele(GEN H1, GEN H2, GEN D, ulong *po, long flag)
{
  ulong x, h, n = F2v_hamming(H2), f = H1[1], O = 0, X = 0, XO = 0;
  if (!n) return 0;
  for (x = 2; x < f; x++) if (F2v_coeff(H2, x))
  {
    ulong xo, o = order_H_x(H1, x, D, &xo);
    if (o > O) { O = o; X = x; XO = xo; if (o == n) break; }
  }
  /* X of maximal order O in H2/H1 */
  *po = O; if (!flag || XO == 1) return X;
  /* find h in H1 s.t. (Xh)^o=1 */
  x = Fl_inv(XO, f);
  for (h = 1;; h++) /* stops for h < f */
    if (F2v_coeff(H1, h) && x == Fl_powu(h, O, f)) break;
  return Fl_mul(X, h, f);
}
/* x not in H. Replace H in place by the subgroup generated by H and x,
 * which has order o > 1 in G/H */
static void
enlarge_H(GEN H, ulong x, ulong o)
{
  pari_sp av = avma;
  ulong i, j, l = lg(H), f = H[1];
  GEN H1 = vecsmall_copy(H), y = Fl_powers(x, o-1, f);
  for (i = 1; i < f; i++)
    if (F2v_coeff(H, i))
      for (j = 2; j <= o; j++) F2v_set(H1, Fl_mul(i, y[j], f));
  for (i = 2; i < l; i++) H[i] = H1[i];
  set_avma(av);
}
/* H F2v subgroup of (Z/fZ)^*: a in H <=> H[a] = 1
 * Return generators. If flag is set, they generate the cyclic components */
GEN
znsubgroupgenerators(GEN H, long flag)
{
  pari_sp av = avma;
  ulong f, g, o;
  GEN H1, H2, z = const_vecsmall(0,0), D;
  switch(typ(H))
  {
    case t_VECSMALL: H = Flv_to_F2v(H); break;
    case t_VEC: if (RgV_is_ZV(H)) { H = ZV_to_F2v(H); break; }
    default: pari_err_TYPE("znsubgroupgenerators", H);
  }
  f = H[1]; z = cgetg(1, t_VECSMALL);
  D = divisorsu(F2v_hamming(H));
  H1 = zero_F2v(f); F2v_set(H1, 1);
  H2 = H;
  while ((g = max_order_ele(H1, H2, D, &o, flag)))
  {
    z = vecsmall_append(z, g); enlarge_H(H1, g, o);
    F2v_negimply_inplace(H2, H1);  /* H2 <- H2 - H1 */
  }
  return gc_upto(av, zv_to_ZV(z));
}

/*************************************************************************/
/**                                                                     **/
/**                     znstar/HNF interface                            **/
/**                                                                     **/
/*************************************************************************/

static long
mod_to_small(GEN x)
{ return itos(typ(x) == t_INTMOD ? gel(x,2): x); }

static GEN
vecmod_to_vecsmall(GEN x)
{ pari_APPLY_long(mod_to_small(gel(x,i))) }

/* Convert a true znstar output by znstar to a `small znstar' */
GEN
znstar_small(GEN zn)
{
  GEN Z = cgetg(4,t_VEC);
  gel(Z,1) = icopy(gmael3(zn,3,1,1));
  gel(Z,2) = vec_to_vecsmall(gel(zn,2));
  gel(Z,3) = vecmod_to_vecsmall(gel(zn,3)); return Z;
}

/* Compute generators for the subgroup of (Z/nZ)* given in HNF. */
GEN
znstar_hnf_generators(GEN Z, GEN M)
{
  long j, h, l = lg(M);
  GEN gen = cgetg(l, t_VECSMALL);
  pari_sp ltop = avma;
  GEN zgen = gel(Z,3);
  ulong n = itou(gel(Z,1));
  for (j = 1; j < l; j++)
  {
    GEN Mj = gel(M,j);
    gen[j] = 1;
    for (h = 1; h < l; h++)
    {
      ulong u = itou(gel(Mj,h));
      if (!u) continue;
      gen[j] = Fl_mul(uel(gen,j), Fl_powu(uel(zgen,h), u, n), n);
    }
  }
  set_avma(ltop); return gen;
}

GEN
znstar_hnf(GEN Z, GEN M)
{ return znstar_generate(itos(gel(Z,1)),znstar_hnf_generators(Z,M)); }

GEN
znstar_hnf_elts(GEN Z, GEN H)
{
  pari_sp ltop = avma;
  GEN G = znstar_hnf(Z,H);
  long n = itos(gel(Z,1));
  return gc_upto(ltop, znstar_elts(n,G));
}

/*************************************************************************/
/**                                                                     **/
/**                     polsubcyclo                                     **/
/**                                                                     **/
/*************************************************************************/

static GEN
gscycloconductor(GEN g, long n, long flag)
{
  if (flag==2) retmkvec2(gcopy(g), stoi(n));
  return g;
}

static long
lift_check_modulus(GEN H, long n)
{
  long h;
  switch(typ(H))
  {
    case t_INTMOD:
      if (!equalsi(n, gel(H,1)))
        pari_err_MODULUS("galoissubcyclo", stoi(n), gel(H,1));
      H = gel(H,2); /* fall through */
    case t_INT:
      h = smodis(H,n);
      if (ugcd(h,n) != 1) pari_err_COPRIME("galoissubcyclo", H,stoi(n));
      return h ? h: 1;
  }
  pari_err_TYPE("galoissubcyclo [subgroup]", H);
  return 0;/*LCOV_EXCL_LINE*/
}

/* Compute z^ex using the baby-step/giant-step table powz
 * with only one multiply.
 * In the modular case, the result is not reduced. */
static GEN
polsubcyclo_powz(GEN powz, long ex)
{
  long m = lg(gel(powz,1))-1, q = ex/m, r = ex%m; /*ex=m*q+r*/
  GEN g = gmael(powz,1,r+1), G = gmael(powz,2,q+1);
  return (lg(powz)==4)? mulreal(g,G): gmul(g,G);
}

static GEN
polsubcyclo_complex_bound(pari_sp av, GEN V, long prec)
{
  GEN pol = real_i(roots_to_pol(V,0));
  return gc_INT(av, ceil_safe(gsupnorm(pol,prec)));
}

/* Newton sums mod le. if le==NULL, works with complex instead */
static GEN
polsubcyclo_cyclic(long n, long d, long m, long z, long g, GEN powz, GEN le)
{
  GEN V = cgetg(d+1,t_VEC);
  ulong base = 1;
  long i,k;
  pari_timer ti;
  if (DEBUGLEVEL >= 6) timer_start(&ti);
  for (i=1; i<=d; i++, base = Fl_mul(base,z,n))
  {
    pari_sp av = avma;
    long ex = base;
    GEN s = gen_0;
    for (k=0; k<m; k++, ex = Fl_mul(ex,g,n))
    {
      s = gadd(s, polsubcyclo_powz(powz,ex));
      if ((k&0xff)==0) s = gc_upto(av,s);
    }
    if (le) s = modii(s, le);
    gel(V,i) = gc_upto(av, s);
  }
  if (DEBUGLEVEL >= 6) timer_printf(&ti, "polsubcyclo_cyclic");
  return V;
}

struct _subcyclo_orbits_u
{
  GEN bab, gig;
  ulong l;
  ulong s;
  long m;
};

static void
_Fl_subcyclo_orbits(void *E, long k)
{
  struct _subcyclo_orbits_u *D = (struct _subcyclo_orbits_u *) E;
  ulong l = D->l;
  long q = k/D->m, r = k%D->m; /*k=m*q+r*/
  ulong g = uel(D->bab,r+1), G = uel(D->gig,q+1);
  D->s = Fl_add(D->s, Fl_mul(g, G, l), l);
}

/* Newton sums mod le. if le==NULL, works with complex instead */
static GEN
Fl_polsubcyclo_orbits(long n, GEN H, GEN O, ulong z, ulong l)
{
  long i, d = lg(O);
  GEN V = cgetg(d,t_VECSMALL);
  struct _subcyclo_orbits_u D;
  long m = 1+usqrt(n);
  D.l = l;
  D.m = m;
  D.bab = Fl_powers(z, m, l);
  D.gig = Fl_powers(uel(D.bab,m+1), m-1, l);
  for(i=1; i<d; i++)
  {
    D.s = 0;
    znstar_coset_func(n, H, _Fl_subcyclo_orbits, (void *) &D, O[i]);
    uel(V,i) = D.s;
  }
  return V;
}

struct _subcyclo_orbits_s
{
  GEN powz;
  GEN *s;
  ulong count;
  pari_sp ltop;
};

static void
_subcyclo_orbits(struct _subcyclo_orbits_s *data, long k)
{
  GEN powz = data->powz;
  GEN *s = data->s;

  if (!data->count) data->ltop = avma;
  *s = gadd(*s, polsubcyclo_powz(powz,k));
  data->count++;
  if ((data->count & 0xffUL) == 0) *s = gc_upto(data->ltop, *s);
}

/* Newton sums mod le. if le==NULL, works with complex instead */
static GEN
polsubcyclo_orbits(long n, GEN H, GEN O, GEN powz, GEN le)
{
  long i, d = lg(O);
  GEN V = cgetg(d,t_VEC);
  struct _subcyclo_orbits_s data;
  long lle = le?lg(le)*2+1: 2*lg(gmael(powz,1,2))+3;/*dvmdii uses lx+ly space*/
  data.powz = powz;
  for(i=1; i<d; i++)
  {
    GEN s = gen_0;
    pari_sp av = avma;
    (void)new_chunk(lle);
    data.count = 0;
    data.s     = &s;
    znstar_coset_func(n, H, (void (*)(void *,long)) _subcyclo_orbits,
      (void *) &data, O[i]);
    set_avma(av); /* HACK */
    gel(V,i) = le? modii(s,le): gcopy(s);
  }
  return V;
}

static GEN
polsubcyclo_start(long n, long d, long o, long e, GEN borne, long *ptr_val,long *ptr_l)
{
  pari_sp av;
  GEN le, z, gl;
  long i, l, val;
  l = e*n+1;
  while(!uisprime(l)) { l += n; e++; }
  if (DEBUGLEVEL >= 4) err_printf("Subcyclo: prime l=%ld\n",l);
  gl = utoipos(l); av = avma;
  if (!borne)
  { /* Use vecmax(Vec((x+o)^d)) = max{binomial(d,i)*o^i ;1<=i<=d} */
    i = d-(1+d)/(1+o);
    borne = mulii(binomial(utoipos(d),i),powuu(o,i));
  }
  if (DEBUGLEVEL >= 4) err_printf("Subcyclo: bound=2^%ld\n",expi(borne));
  val = logint(shifti(borne,2), gl) + 1;
  set_avma(av);
  if (DEBUGLEVEL >= 4) err_printf("Subcyclo: val=%ld\n",val);
  le = powiu(gl,val);
  z = utoipos( Fl_powu(pgener_Fl(l), e, l) );
  z = Zp_sqrtnlift(gen_1,utoipos(n),z,gl,val);
  *ptr_val = val;
  *ptr_l = l;
  return gmodulo(z,le);
}

/*Fill in the powz table:
 *  powz[1]: baby-step
 *  powz[2]: giant-step
 *  powz[3] exists only if the field is real (value is ignored). */
static GEN
polsubcyclo_complex_roots(long n, long real, long prec)
{
  long i, m = (long)(1+sqrt((double) n));
  GEN bab, gig, powz = cgetg(real?4:3, t_VEC);

  bab = cgetg(m+1,t_VEC);
  gel(bab,1) = gen_1;
  gel(bab,2) = rootsof1u_cx(n, prec); /* = e_n(1) */
  for (i=3; i<=m; i++) gel(bab,i) = gmul(gel(bab,2),gel(bab,i-1));
  gig = cgetg(m+1,t_VEC);
  gel(gig,1) = gen_1;
  gel(gig,2) = gmul(gel(bab,2),gel(bab,m));;
  for (i=3; i<=m; i++) gel(gig,i) = gmul(gel(gig,2),gel(gig,i-1));
  gel(powz,1) = bab;
  gel(powz,2) = gig;
  if (real) gel(powz,3) = gen_0;
  return powz;
}

static GEN
muliimod_sz(GEN x, GEN y, GEN l, long siz)
{
  pari_sp av = avma;
  GEN p1;
  (void)new_chunk(siz); /* HACK */
  p1 = mulii(x,y);
  set_avma(av); return modii(p1,l);
}

static GEN
polsubcyclo_roots(long n, GEN zl)
{
  GEN le = gel(zl,1), z = gel(zl,2);
  long i, lle = lg(le)*3; /*Assume dvmdii use lx+ly space*/
  long m = (long)(1+sqrt((double) n));
  GEN bab, gig, powz = cgetg(3,t_VEC);
  pari_timer ti;
  if (DEBUGLEVEL >= 6) timer_start(&ti);
  bab = cgetg(m+1,t_VEC);
  gel(bab,1) = gen_1;
  gel(bab,2) = icopy(z);
  for (i=3; i<=m; i++) gel(bab,i) = muliimod_sz(z,gel(bab,i-1),le,lle);
  gig = cgetg(m+1,t_VEC);
  gel(gig,1) = gen_1;
  gel(gig,2) = muliimod_sz(z,gel(bab,m),le,lle);;
  for (i=3; i<=m; i++) gel(gig,i) = muliimod_sz(gel(gig,2),gel(gig,i-1),le,lle);
  if (DEBUGLEVEL >= 6) timer_printf(&ti, "polsubcyclo_roots");
  gel(powz,1) = bab;
  gel(powz,2) = gig; return powz;
}

GEN
galoiscyclo(long n, long v)
{
  ulong av = avma;
  GEN grp, G, z, le, L, elts;
  long val, l, i, j, k;
  GEN zn = znstar(stoi(n));
  long card = itos(gel(zn,1));
  GEN gen = vec_to_vecsmall(lift_shallow(gel(zn,3)));
  GEN ord = vec_to_vecsmall(gel(zn,2));
  GEN T = polcyclo(n,v);
  long d = degpol(T);
  GEN borneabs = powuu(2,d);
  z = polsubcyclo_start(n,card/2,2,2*usqrt(d),borneabs,&val,&l);
  le = gel(z,1); z = gel(z,2);
  L = cgetg(1+card,t_VEC);
  gel(L,1) = z;
  for (j = 1, i = 1; j < lg(gen); j++)
  {
    long c = i * (ord[j]-1);
    for (k = 1; k <= c; k++) gel(L,++i) = Fp_powu(gel(L,k), gen[j], le);
  }
  G = abelian_group(ord);
  elts = group_elts(G, card); /*not stack clean*/
  grp = cgetg(9, t_VEC);
  gel(grp,1) = T;
  gel(grp,2) = mkvec3(stoi(l), stoi(val), icopy(le));
  gel(grp,3) = L;
  gel(grp,4) = FpV_invVandermonde(L,  NULL, le);
  gel(grp,5) = gen_1;
  gel(grp,6) = elts;
  gel(grp,7) = gel(G,1);
  gel(grp,8) = gel(G,2);
  return gc_GEN(av, grp);
}

/* Convert a bnrinit(Q,n) to an abelian group similar to znstar(n), with
 * t_INTMOD generators; set cx = 0 if the class field is real and to 1
 * otherwise */
static GEN
bnr_to_abgrp(GEN bnr, long *cx)
{
  GEN gen, F, v, bid, G, Ui = NULL;
  long l, i;
  checkbnr(bnr);
  bid = bnr_get_bid(bnr);
  G = bnr_get_clgp(bnr);
  if (lg(G) == 4)
    gen = abgrp_get_gen(G);
  else
  {
    Ui = gmael(bnr,4,3);
    if (ZM_isidentity(Ui)) Ui = NULL;
    gen = bid_get_gen(bid);
  }
  F = bid_get_ideal(bid);
  if (lg(F) != 2)
    pari_err_DOMAIN("bnr_to_abgrp", "bnr", "!=", strtoGENstr("Q"), bnr);
  /* F is the finite part of the conductor, cx is the infinite part*/
  F = gcoeff(F, 1, 1);
  *cx = signe(gel(bid_get_arch(bid), 1));
  l = lg(gen); v = cgetg(l, t_VEC);
  for (i = 1; i < l; ++i)
  {
    GEN x = gel(gen,i);
    if (typ(x) == t_COL) x = gel(x,1);
    gel(v,i) = gmodulo(absi_shallow(x), F);
  }
  if (Ui)
  { /* from bid.gen to bnr.gen (maybe one less) */
    GEN w = v;
    l = lg(Ui); v = cgetg(l, t_VEC);
    for (i = 1; i < l; i++) gel(v,i) = factorback2(w, gel(Ui, i));
  }
  return mkvec3(bnr_get_no(bnr), bnr_get_cyc(bnr), v);
}

static long
_itos(const char *fun, GEN n)
{
  if (is_bigint(n))
    pari_err_IMPL(stack_sprintf("conductor f > %ld in %s", LONG_MAX, fun));
  return itos(n);
}
long
subcyclo_nH(const char *fun, GEN N, GEN *psg)
{
  GEN V, Z = NULL, H = *psg;
  long i, l, n = 0, complex = 1;
  switch(typ(N))
  {
    case t_INT:
      n = _itos(fun, N);
      if (n < 1) pari_err_DOMAIN(fun, "degree", "<=", gen_0, N);
      break;
    case t_VEC:
      if (lg(N)==7)
        N = bnr_to_abgrp(N,&complex);
      else if (checkznstar_i(N))
        N = mkvec3(znstar_get_no(N), znstar_get_cyc(N),
                   gmodulo(znstar_get_gen(N), znstar_get_N(N)));
      if (lg(N)==4)
      { /* abgrp */
        GEN gen = abgrp_get_gen(N), z;
        if (typ(gen)!=t_VEC) pari_err_TYPE(fun,gen);
        Z = N;
        if (lg(gen) == 1) { n = 1; break; }
        z = gel(gen,1);
        if (typ(z) == t_INTMOD) { n = _itos(fun, gel(z,1)); break; }
      }
    default: /*fall through*/
      pari_err_TYPE(fun,N);
      return 0;/*LCOV_EXCL_LINE*/
  }
  if (!H) H = gen_1;
  switch(typ(H))
  {
     case t_INTMOD: case t_INT:
      V = mkvecsmall( lift_check_modulus(H,n) );
      break;
    case t_VECSMALL:
      l = lg(H); V = leafcopy(H);
      for (i = 1; i < l; i++) { V[i] %= n; if (V[i] < 0) V[i] += n; }
      break;
    case t_VEC: case t_COL:
      l = lg(H); V = cgetg(l,t_VECSMALL);
      for(i=1; i < l; i++) V[i] = lift_check_modulus(gel(H,i),n);
      break;
    case t_MAT:
      l = lg(H);
      if (l == 1 || l != lgcols(H))
        pari_err_TYPE(stack_strcat(fun," [H not in HNF]"),H);
      if (!Z) pari_err_TYPE(stack_strcat(fun," [N not a bnrinit or znstar]"),H);
      if (lg(gel(Z,2)) != l) pari_err_DIM(fun);
      V = znstar_hnf_generators(znstar_small(Z),H);
      break;
    default:
      pari_err_TYPE(fun,H);
      return 0;/*LCOV_EXCL_LINE*/
  }
  if (!complex) V = vecsmall_append(V, n-1); /*add complex conjugation*/
  *psg = V; return n;
}

GEN
galoissubcyclo(GEN N, GEN sg, long flag, long v)
{
  pari_sp ltop = avma, av;
  GEN H, B, zl, L, T, le, powz, O;
  long i, card, phi_n, val,l, n, cnd, complex;
  pari_timer ti;

  if (flag<0 || flag>3) pari_err_FLAG("galoissubcyclo");
  if (v < 0) v = 0;
  n = subcyclo_nH("galoissubcyclo", N, &sg);
  if (n==1)
  {
    set_avma(ltop); if (flag == 1) return gen_1;
    return gscycloconductor(deg1pol_shallow(gen_1, gen_m1, v), 1, flag);
  }
  H = znstar_generate(n, sg);
  if (DEBUGLEVEL >= 6)
  {
    err_printf("Subcyclo: elements:");
    for (i=1;i<n;i++)
      if (F2v_coeff(gel(H,3),i)) err_printf(" %ld",i);
    err_printf("\n");
  }
  /* field is real iff z -> conj(z) = z^-1 = z^(n-1) is in H */
  complex = !F2v_coeff(gel(H,3),n-1);
  if (DEBUGLEVEL >= 6) err_printf("Subcyclo: complex=%ld\n",complex);
  if (DEBUGLEVEL >= 1) timer_start(&ti);
  cnd = znstar_conductor(H);
  if (DEBUGLEVEL >= 1) timer_printf(&ti, "znstar_conductor");
  if (flag == 1)  return gc_stoi(ltop, cnd);
  if (cnd == 1)
  {
    set_avma(ltop); if (flag == 1) return gen_1;
    return gscycloconductor(deg1pol_shallow(gen_1,gen_m1,v),1,flag);
  }
  if (n != cnd)
  {
    H = znstar_reduce_modulus(H, cnd);
    n = cnd;
  }
  card = znstar_order(H);
  phi_n = eulerphiu(n);
  if (card == phi_n)
  {
    set_avma(ltop);
    return gscycloconductor(polcyclo(n,v),n,flag);
  }
  O = znstar_cosets(n, phi_n, H);
  if (DEBUGLEVEL >= 1) timer_printf(&ti, "znstar_cosets");
  if (DEBUGLEVEL >= 6) err_printf("Subcyclo: orbits=%Ps\n",O);
  if (DEBUGLEVEL >= 4)
    err_printf("Subcyclo: %ld orbits with %ld elements each\n",phi_n/card,card);
  av = avma;
  powz = polsubcyclo_complex_roots(n,!complex,LOWDEFAULTPREC);
  L = polsubcyclo_orbits(n,H,O,powz,NULL);
  B = polsubcyclo_complex_bound(av,L,LOWDEFAULTPREC);
  zl = polsubcyclo_start(n,phi_n/card,card,1,B,&val,&l);
  powz = polsubcyclo_roots(n,zl);
  le = gel(zl,1);
  L = polsubcyclo_orbits(n,H,O,powz,le);
  if (DEBUGLEVEL >= 6) timer_start(&ti);
  T = FpV_roots_to_pol(L,le,v);
  if (DEBUGLEVEL >= 6) timer_printf(&ti, "roots_to_pol");
  T = FpX_center(T,le,shifti(le,-1));
  if (flag==3)
  {
    GEN L2, aut;
    if (Flx_is_squarefree(ZX_to_Flx(T, l),l))
      L2 = ZV_to_Flv(L,l);
    else
    {
      ulong z;
      do l+=n; while (!uisprime(l) || !Flx_is_squarefree(ZX_to_Flx(T, l), l));
      z = rootsof1_Fl(n,l);
      L2 = Fl_polsubcyclo_orbits(n,H,O,z,l);
      if (DEBUGLEVEL >= 4)
        err_printf("galoissubcyclo: switching to unramified prime %lu\n",l);
    }
    aut  = znstar_quotient(n, phi_n, H, L2, l);
    return gc_upto(ltop, galoisinitfromaut(T, aut, l));
  }
  return gc_upto(ltop, gscycloconductor(T,n,flag));
}

/* Z = znstar(n) cyclic. n = 1,2,4,p^a or 2p^a,
 * and d | phi(n) = 1,1,2,(p-1)p^(a-1) */
static GEN
polsubcyclo_g(long n, long d, GEN Z, long v)
{
  pari_sp ltop = avma;
  long o, p, r, g, gd, l, val;
  GEN zl, L, T, le, B, powz;
  pari_timer ti;
  if (d==1) return deg1pol_shallow(gen_1,gen_m1,v); /* get rid of n=1,2 */
  if ((n & 3) == 2) n >>= 1;
  /* n = 4 or p^a, p odd */
  o = itos(gel(Z,1));
  g = itos(gmael3(Z,3,1,2));
  p = n / ugcd(n,o); /* p^a / gcd(p^a,phi(p^a)) = p*/
  r = ugcd(d,n); /* = p^(v_p(d)) < n */
  n = r*p; /* n is now the conductor */
  o = n-r; /* = phi(n) */
  if (o == d) return polcyclo(n,v);
  o /= d;
  gd = Fl_powu(g%n, d, n);
  /*FIXME: If degree is small, the computation of B is a waste of time*/
  powz = polsubcyclo_complex_roots(n,(o&1)==0,LOWDEFAULTPREC);
  L = polsubcyclo_cyclic(n,d,o,g,gd,powz,NULL);
  B = polsubcyclo_complex_bound(ltop,L,LOWDEFAULTPREC);
  zl = polsubcyclo_start(n,d,o,1,B,&val,&l);
  le = gel(zl,1);
  powz = polsubcyclo_roots(n,zl);
  L = polsubcyclo_cyclic(n,d,o,g,gd,powz,le);
  if (DEBUGLEVEL >= 6) timer_start(&ti);
  T = FpV_roots_to_pol(L,le,v);
  if (DEBUGLEVEL >= 6) timer_printf(&ti, "roots_to_pol");
  return gc_upto(ltop, FpX_center(T,le,shifti(le,-1)));
}

GEN
polsubcyclo(long n, long d, long v)
{
  pari_sp ltop = avma;
  GEN L, Z;
  if (v<0) v = 0;
  if (d<=0) pari_err_DOMAIN("polsubcyclo","d","<=",gen_0,stoi(d));
  if (n<=0) pari_err_DOMAIN("polsubcyclo","n","<=",gen_0,stoi(n));
  Z = znstar(stoi(n));
  if (!dvdis(gel(Z,1), d)) retgc_const(ltop, cgetg(1, t_VEC));
  if (lg(gel(Z,2)) == 2)
  { /* faster but Z must be cyclic */
    set_avma(ltop);
    return polsubcyclo_g(n, d, Z, v);
  }
  L = subgrouplist(gel(Z,2), mkvec(stoi(d)));
  if (lg(L) == 2)
    return gc_upto(ltop, galoissubcyclo(Z, gel(L,1), 0, v));
  else
  {
    GEN V = cgetg(lg(L),t_VEC);
    long i;
    for (i=1; i< lg(V); i++) gel(V,i) = galoissubcyclo(Z, gel(L,i), 0, v);
    return gc_upto(ltop, V);
  }
}

struct aurifeuille_t {
  GEN z, le;
  ulong l;
  long e;
};

/* Let z a primitive n-th root of 1, n > 1, A an integer such that
 * Aurifeuillian factorization of Phi_n(A) exists ( z.A is a square in Q(z) ).
 * Let G(p) the Gauss sum mod p prime:
 *      sum_x (x|p) z^(xn/p) for p odd,  i - 1 for p = 2 [ i := z^(n/4) ]
 * We have N(-1) = Nz = 1 (n != 1,2), and
 *      G^2 = (-1|p) p for p odd,  G^2 = -2i for p = 2
 * In particular, for odd A, (-1|A) A = g^2 is a square. If A = prod p^{e_p},
 * sigma_j(g) = \prod_p (sigma_j G(p)))^e_p = \prod_p (j|p)^e_p g = (j|A) g
 * n odd  : z^2 is a primitive root, A = g^2
 *   Phi_n(A) = N(A - z^2) = N(g - z) N(g + z)
 *
 * n = 2 (4) : -z^2 is a primitive root, -A = g^2
 *   Phi_n(A) = N(A - (-z^2)) = N(g^2 - z^2)  [ N(-1) = 1 ]
 *                            = N(g - z) N(g + z)
 *
 * n = 4 (8) : i z^2 primitive root, -Ai = g^2
 *   Phi_n(A) = N(A - i z^2) = N(-Ai -  z^2) = N(g - z) N(g + z)
 * sigma_j(g) / g =  (j|A)  if j = 1 (4)
 *                  (-j|A)i if j = 3 (4)
 *   */
/* factor Phi_n(A), Astar: A* = squarefree kernel of A, P = odd prime divisors
 * of n */
static GEN
factor_Aurifeuille_aux(GEN A, long Astar, long n, GEN P,
                       struct aurifeuille_t *S)
{
  pari_sp av;
  GEN f, a, b, s, powers, z = S->z, le = S->le;
  long j, k, maxjump, lastj, e = S->e;
  ulong l = S->l;
  char *invertible;

  if ((n & 7) == 4)
  { /* A^* even */
    GEN i = Fp_powu(z, n>>2, le), z2 = Fp_sqr(z, le);

    invertible = stack_malloc(n); /* even indices unused */
    for (j = 1; j < n; j+=2) invertible[j] = 1;
    for (k = 1; k < lg(P); k++)
    {
      long p = P[k];
      for (j = p; j < n; j += 2*p) invertible[j] = 0;
    }
    lastj = 1; maxjump = 2;
    for (j= 3; j < n; j+=2)
      if (invertible[j]) {
        long jump = j - lastj;
        if (jump > maxjump) maxjump = jump;
        lastj = j;
      }
    powers = cgetg(maxjump+1, t_VEC); /* powers[k] = z^k, odd indices unused */
    gel(powers,2) = z2;
    for (k = 4; k <= maxjump; k+=2)
      gel(powers,k) = odd(k>>1)? Fp_mul(gel(powers, k-2), z2, le)
                               : Fp_sqr(gel(powers, k>>1), le);

    if (Astar == 2)
    { /* important special case (includes A=2), split for efficiency */
      if (!equalis(A, 2))
      {
        GEN f = sqrti(shifti(A,-1)), mf = Fp_neg(f,le), fi = Fp_mul(f,i,le);
        a = Fp_add(mf, fi, le);
        b = Fp_sub(mf, fi, le);
      }
      else
      {
        a = subiu(i,1);
        b = subsi(-1,i);
      }
      av = avma;
      s = z; f = subii(a, s); lastj = 1;
      for (j = 3, k = 0; j < n; j+=2)
        if (invertible[j])
        {
          s = Fp_mul(gel(powers, j-lastj), s, le); /* z^j */
          lastj = j;
          f = Fp_mul(f, subii((j & 3) == 1? a: b, s), le);
          if (++k == 0x1ff) { (void)gc_all(av, 2, &s, &f); k = 0; }
        }
    }
    else
    {
      GEN ma, mb, B = Fp_mul(A, i, le), gl = utoipos(l);
      long t;
      Astar >>= 1;
      t = Astar & 3; if (Astar < 0) t = 4-t; /* t = 1 or 3 */
      if (t == 1) B = Fp_neg(B, le);
      a = Zp_sqrtlift(B, Fp_sqrt(B, gl), gl, e);
      b = Fp_mul(a, i, le);
      ma = Fp_neg(a, le);
      mb = Fp_neg(b, le);
      av = avma;
      s = z; f = subii(a, s); lastj = 1;
      for (j = 3, k = 0; j<n; j+=2)
        if (invertible[j])
        {
          GEN t;
          if ((j & 3) == 1) t = (kross(j, Astar) < 0)? ma: a;
          else              t = (kross(j, Astar) < 0)? mb: b;
          s = Fp_mul(gel(powers, j-lastj), s, le); /* z^j */
          lastj = j;
          f = Fp_mul(f, subii(t, s), le);
          if (++k == 0x1ff) { (void)gc_all(av, 2, &s, &f); k = 0; }
        }
    }
  }
  else /* A^* odd */
  {
    ulong g;
    if ((n & 3) == 2)
    { /* A^* = 3 (mod 4) */
      A = negi(A); Astar = -Astar;
      z = Fp_neg(z, le);
      n >>= 1;
    }
    /* A^* = 1 (mod 4) */
    g = Fl_sqrt(umodiu(A,l), l);
    a = Zp_sqrtlift(A, utoipos(g), utoipos(l), e);
    b = negi(a);

    invertible = stack_malloc(n);
    for (j = 1; j < n; j++) invertible[j] = 1;
    for (k = 1; k < lg(P); k++)
    {
      long p = P[k];
      for (j = p; j < n; j += p) invertible[j] = 0;
    }
    lastj = 2; maxjump = 1;
    for (j= 3; j < n; j++)
      if (invertible[j]) {
        long jump = j - lastj;
        if (jump > maxjump) maxjump = jump;
        lastj = j;
      }
    powers = cgetg(maxjump+1, t_VEC); /* powers[k] = z^k */
    gel(powers,1) = z;
    for (k = 2; k <= maxjump; k++)
      gel(powers,k) = odd(k)? Fp_mul(gel(powers, k-1), z, le)
                            : Fp_sqr(gel(powers, k>>1), le);
    av = avma;
    s = z; f = subii(a, s); lastj = 1;
    for(j = 2, k = 0; j < n; j++)
      if (invertible[j])
      {
        s = Fp_mul(gel(powers, j-lastj), s, le);
        lastj = j;
        f = Fp_mul(f, subii(kross(j,Astar)==1? a: b, s), le);
        if (++k == 0x1ff) { (void)gc_all(av, 2, &s, &f); k = 0; }
      }
  }
  return f;
}

/* d != 2 mod 4; fd = factoru(odd(d)? d: d / 4) */
static void
Aurifeuille_init(GEN a, long d, GEN fd, struct aurifeuille_t *S)
{
  GEN bound, zl, sqrta = sqrtr_abs(itor(a, LOWDEFAULTPREC));
  ulong phi = eulerphiu_fact(fd);
  if (!odd(d)) phi <<= 1; /* eulerphi(d) */
  bound = ceil_safe(powru(addrs(sqrta,1), phi));
  zl = polsubcyclo_start(d, 0, 0, 1, bound, &(S->e), (long*)&(S->l));
  S->le = gel(zl,1);
  S->z  = gel(zl,2);
}

GEN
factor_Aurifeuille_prime(GEN p, long d)
{
  pari_sp av = avma;
  struct aurifeuille_t S;
  GEN fd;
  long pp;
  if ((d & 3) == 2) { d >>= 1; p = negi(p); }
  fd = factoru(odd(d)? d: d>>2);
  pp = itos(p);
  Aurifeuille_init(p, d, fd, &S);
  return gc_INT(av, factor_Aurifeuille_aux(p, pp, d, gel(fd,1), &S));
}

/* an algebraic factor of Phi_d(a), a != 0 */
GEN
factor_Aurifeuille(GEN a, long d)
{
  pari_sp av = avma;
  GEN fd, P, A;
  long i, lP, va = vali(a), sa, astar, D;
  struct aurifeuille_t S;

  if (d <= 0)
    pari_err_DOMAIN("factor_Aurifeuille", "degre", "<=",gen_0,stoi(d));
  if ((d & 3) == 2) { d >>= 1; a = negi(a); }
  if ((va & 1) == (d & 1)) { set_avma(av); return gen_1; }
  sa = signe(a);
  if (odd(d))
  {
    long a4;
    if (d == 1)
    {
      if (!Z_issquareall(a, &A)) return gen_1;
      return gc_INT(av, addiu(A,1));
    }
    A = va? shifti(a, -va): a;
    a4 = mod4(A); if (sa < 0) a4 = 4 - a4;
    if (a4 != 1) { set_avma(av); return gen_1; }
  }
  else if ((d & 7) == 4)
    A = shifti(a, -va);
  else
  {
    set_avma(av); return gen_1;
  }
  /* v_2(d) = 0 or 2. Kill 2 from factorization (minor efficiency gain) */
  fd = factoru(odd(d)? d: d>>2); P = gel(fd,1); lP = lg(P);
  astar = sa;
  if (odd(va)) astar <<= 1;
  for (i = 1; i < lP; i++)
    if (odd( (Z_lvalrem(A, P[i], &A)) ) ) astar *= P[i];
  if (sa < 0)
  { /* negate in place if possible */
    if (A == a) A = icopy(A);
    setabssign(A);
  }
  if (!Z_issquare(A)) { set_avma(av); return gen_1; }

  D = odd(d)? 1: 4;
  for (i = 1; i < lP; i++) D *= P[i];
  if (D != d) { a = powiu(a, d/D); d = D; }

  Aurifeuille_init(a, d, fd, &S);
  return gc_INT(av, factor_Aurifeuille_aux(a, astar, d, P, &S));
}
