Code coverage tests

This page documents the degree to which the PARI/GP source code is tested by our public test suite, distributed with the source distribution in directory src/test/. This is measured by the gcov utility; we then process gcov output using the lcov frond-end.

We test a few variants depending on Configure flags on the pari.math.u-bordeaux.fr machine (x86_64 architecture), and agregate them in the final report:

The target is to exceed 90% coverage for all mathematical modules (given that branches depending on DEBUGLEVEL or DEBUGMEM are not covered). This script is run to produce the results below.

LCOV - code coverage report
Current view: top level - basemath - base3.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.18.1 lcov report (development 30365-beea1ff998) Lines: 2051 2158 95.0 %
Date: 2025-07-01 09:21:48 Functions: 226 237 95.4 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : /* Copyright (C) 2000  The PARI group.
       2             : 
       3             : This file is part of the PARI/GP package.
       4             : 
       5             : PARI/GP is free software; you can redistribute it and/or modify it under the
       6             : terms of the GNU General Public License as published by the Free Software
       7             : Foundation; either version 2 of the License, or (at your option) any later
       8             : version. It is distributed in the hope that it will be useful, but WITHOUT
       9             : ANY WARRANTY WHATSOEVER.
      10             : 
      11             : Check the License for details. You should have received a copy of it, along
      12             : with the package; see the file 'COPYING'. If not, write to the Free Software
      13             : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      14             : 
      15             : /*******************************************************************/
      16             : /*                                                                 */
      17             : /*                       BASIC NF OPERATIONS                       */
      18             : /*                                                                 */
      19             : /*******************************************************************/
      20             : #include "pari.h"
      21             : #include "paripriv.h"
      22             : 
      23             : #define DEBUGLEVEL DEBUGLEVEL_nf
      24             : 
      25             : /*******************************************************************/
      26             : /*                                                                 */
      27             : /*                OPERATIONS OVER NUMBER FIELD ELEMENTS.           */
      28             : /*     represented as column vectors over the integral basis       */
      29             : /*                                                                 */
      30             : /*******************************************************************/
      31             : static GEN
      32    40295834 : get_tab(GEN nf, long *N)
      33             : {
      34    40295834 :   GEN tab = (typ(nf) == t_MAT)? nf: gel(nf,9);
      35    40295834 :   *N = nbrows(tab); return tab;
      36             : }
      37             : 
      38             : /* x != 0, y t_INT. Return x * y (not memory clean if x = 1) */
      39             : static GEN
      40  1091157169 : _mulii(GEN x, GEN y) {
      41  1764033515 :   return is_pm1(x)? (signe(x) < 0)? negi(y): y
      42  1763828961 :                   : mulii(x, y);
      43             : }
      44             : 
      45             : GEN
      46        5834 : tablemul_ei_ej(GEN M, long i, long j)
      47             : {
      48             :   long N;
      49        5834 :   GEN tab = get_tab(M, &N);
      50        5834 :   tab += (i-1)*N; return gel(tab,j);
      51             : }
      52             : 
      53             : /* Outputs x.ei, where ei is the i-th elt of the algebra basis.
      54             :  * x an RgV of correct length and arbitrary content (polynomials, scalars...).
      55             :  * M is the multiplication table ei ej = sum_k M_k^(i,j) ek */
      56             : GEN
      57        4158 : tablemul_ei(GEN M, GEN x, long i)
      58             : {
      59             :   long j, k, N;
      60             :   GEN v, tab;
      61             : 
      62        4158 :   if (i==1) return gcopy(x);
      63        4158 :   tab = get_tab(M, &N);
      64        4158 :   if (typ(x) != t_COL) { v = zerocol(N); gel(v,i) = gcopy(x); return v; }
      65        4158 :   tab += (i-1)*N; v = cgetg(N+1,t_COL);
      66             :   /* wi . x = [ sum_j tab[k,j] x[j] ]_k */
      67       27020 :   for (k=1; k<=N; k++)
      68             :   {
      69       22862 :     pari_sp av = avma;
      70       22862 :     GEN s = gen_0;
      71      165396 :     for (j=1; j<=N; j++)
      72             :     {
      73      142534 :       GEN c = gcoeff(tab,k,j);
      74      142534 :       if (!gequal0(c)) s = gadd(s, gmul(c, gel(x,j)));
      75             :     }
      76       22862 :     gel(v,k) = gc_upto(av,s);
      77             :   }
      78        4158 :   return v;
      79             : }
      80             : /* as tablemul_ei, assume x a ZV of correct length */
      81             : GEN
      82    24668370 : zk_ei_mul(GEN nf, GEN x, long i)
      83             : {
      84             :   long j, k, N;
      85             :   GEN v, tab;
      86             : 
      87    24668370 :   if (i==1) return ZC_copy(x);
      88    24668370 :   tab = get_tab(nf, &N); tab += (i-1)*N;
      89    24668359 :   v = cgetg(N+1,t_COL);
      90   172915277 :   for (k=1; k<=N; k++)
      91             :   {
      92   148251060 :     pari_sp av = avma;
      93   148251060 :     GEN s = gen_0;
      94  2162751448 :     for (j=1; j<=N; j++)
      95             :     {
      96  2014637159 :       GEN c = gcoeff(tab,k,j);
      97  2014637159 :       if (signe(c)) s = addii(s, _mulii(c, gel(x,j)));
      98             :     }
      99   148114289 :     gel(v,k) = gc_INT(av, s);
     100             :   }
     101    24664217 :   return v;
     102             : }
     103             : 
     104             : /* table of multiplication by wi in R[w1,..., wN] */
     105             : GEN
     106       40295 : ei_multable(GEN TAB, long i)
     107             : {
     108             :   long k,N;
     109       40295 :   GEN m, tab = get_tab(TAB, &N);
     110       40295 :   tab += (i-1)*N;
     111       40295 :   m = cgetg(N+1,t_MAT);
     112      159391 :   for (k=1; k<=N; k++) gel(m,k) = gel(tab,k);
     113       40295 :   return m;
     114             : }
     115             : 
     116             : GEN
     117    11354605 : zk_multable(GEN nf, GEN x)
     118             : {
     119    11354605 :   long i, l = lg(x);
     120    11354605 :   GEN mul = cgetg(l,t_MAT);
     121    11354546 :   gel(mul,1) = x; /* assume w_1 = 1 */
     122    35652045 :   for (i=2; i<l; i++) gel(mul,i) = zk_ei_mul(nf,x,i);
     123    11350757 :   return mul;
     124             : }
     125             : GEN
     126        2037 : multable(GEN M, GEN x)
     127             : {
     128             :   long i, N;
     129             :   GEN mul;
     130        2037 :   if (typ(x) == t_MAT) return x;
     131           0 :   M = get_tab(M, &N);
     132           0 :   if (typ(x) != t_COL) return scalarmat(x, N);
     133           0 :   mul = cgetg(N+1,t_MAT);
     134           0 :   gel(mul,1) = x; /* assume w_1 = 1 */
     135           0 :   for (i=2; i<=N; i++) gel(mul,i) = tablemul_ei(M,x,i);
     136           0 :   return mul;
     137             : }
     138             : 
     139             : /* x integral in nf; table of multiplication by x in ZK = Z[w1,..., wN].
     140             :  * Return a t_INT if x is scalar, and a ZM otherwise */
     141             : GEN
     142     5347806 : zk_scalar_or_multable(GEN nf, GEN x)
     143             : {
     144     5347806 :   long tx = typ(x);
     145     5347806 :   if (tx == t_MAT || tx == t_INT) return x;
     146     5181911 :   x = nf_to_scalar_or_basis(nf, x);
     147     5181838 :   return (typ(x) == t_COL)? zk_multable(nf, x): x;
     148             : }
     149             : 
     150             : GEN
     151       21303 : nftrace(GEN nf, GEN x)
     152             : {
     153       21303 :   pari_sp av = avma;
     154       21303 :   nf = checknf(nf);
     155       21302 :   x = nf_to_scalar_or_basis(nf, x);
     156       21280 :   x = (typ(x) == t_COL)? RgV_dotproduct(x, gel(nf_get_Tr(nf),1))
     157       21301 :                        : gmulgu(x, nf_get_degree(nf));
     158       21305 :   return gc_upto(av, x);
     159             : }
     160             : GEN
     161        1050 : rnfelttrace(GEN rnf, GEN x)
     162             : {
     163        1050 :   pari_sp av = avma;
     164        1050 :   checkrnf(rnf);
     165             :   /* avoid rnfabstorel special t_POL case misinterpretation */
     166        1043 :   if (typ(x) == t_POL && varn(x) == rnf_get_varn(rnf))
     167          63 :     x = gmodulo(x, rnf_get_pol(rnf));
     168        1043 :   x = rnfeltabstorel(rnf, x);
     169         728 :   x = (typ(x) == t_POLMOD)? rnfeltdown(rnf, gtrace(x))
     170         833 :                           : gmulgu(x, rnf_get_degree(rnf));
     171         833 :   return gc_upto(av, x);
     172             : }
     173             : 
     174             : static GEN
     175          35 : famatQ_to_famatZ(GEN fa)
     176             : {
     177          35 :   GEN E, F, Q, P = gel(fa,1);
     178          35 :   long i, j, l = lg(P);
     179          35 :   if (l == 1 || RgV_is_ZV(P)) return fa;
     180           7 :   Q = cgetg(2*l, t_COL);
     181           7 :   F = cgetg(2*l, t_COL); E = gel(fa, 2);
     182          35 :   for (i = j = 1; i < l; i++)
     183             :   {
     184          28 :     GEN p = gel(P,i);
     185          28 :     if (typ(p) == t_INT)
     186          14 :     { gel(Q, j) = p; gel(F, j) = gel(E, i); j++; }
     187             :     else
     188             :     {
     189          14 :       gel(Q, j) = gel(p,1); gel(F, j) = gel(E, i); j++;
     190          14 :       gel(Q, j) = gel(p,2); gel(F, j) = negi(gel(E, i)); j++;
     191             :     }
     192             :   }
     193           7 :   setlg(Q, j); setlg(F, j); return mkmat2(Q, F);
     194             : }
     195             : static GEN
     196          35 : famat_cba(GEN fa)
     197             : {
     198          35 :   GEN Q, F, P = gel(fa, 1), E = gel(fa, 2);
     199          35 :   long i, j, lQ, l = lg(P);
     200          35 :   if (l == 1) return fa;
     201          28 :   Q = ZV_cba(P); lQ = lg(Q); settyp(Q, t_COL);
     202          28 :   F = cgetg(lQ, t_COL);
     203          77 :   for (j = 1; j < lQ; j++)
     204             :   {
     205          49 :     GEN v = gen_0, q = gel(Q,j);
     206          49 :     if (!equali1(q))
     207         203 :       for (i = 1; i < l; i++)
     208             :       {
     209         161 :         long e = Z_pval(gel(P,i), q);
     210         161 :         if (e) v = addii(v, muliu(gel(E,i), e));
     211             :       }
     212          49 :     gel(F, j) = v;
     213             :   }
     214          28 :   return mkmat2(Q, F);
     215             : }
     216             : static long
     217          35 : famat_sign(GEN fa)
     218             : {
     219          35 :   GEN P = gel(fa,1), E = gel(fa,2);
     220          35 :   long i, l = lg(P), s = 1;
     221         126 :   for (i = 1; i < l; i++)
     222          91 :     if (signe(gel(P,i)) < 0 && mpodd(gel(E,i))) s = -s;
     223          35 :   return s;
     224             : }
     225             : static GEN
     226          35 : famat_abs(GEN fa)
     227             : {
     228          35 :   GEN Q, P = gel(fa,1);
     229             :   long i, l;
     230          35 :   Q = cgetg_copy(P, &l);
     231         126 :   for (i = 1; i < l; i++) gel(Q,i) = absi_shallow(gel(P,i));
     232          35 :   return mkmat2(Q, gel(fa,2));
     233             : }
     234             : 
     235             : /* assume nf is a genuine nf, fa a famat */
     236             : static GEN
     237          35 : famat_norm(GEN nf, GEN fa)
     238             : {
     239          35 :   pari_sp av = avma;
     240          35 :   GEN G, g = gel(fa,1);
     241             :   long i, l, s;
     242             : 
     243          35 :   G = cgetg_copy(g, &l);
     244         112 :   for (i = 1; i < l; i++) gel(G,i) = nfnorm(nf, gel(g,i));
     245          35 :   fa = mkmat2(G, gel(fa,2));
     246          35 :   fa = famatQ_to_famatZ(fa);
     247          35 :   s = famat_sign(fa);
     248          35 :   fa = famat_reduce(famat_abs(fa));
     249          35 :   fa = famat_cba(fa);
     250          35 :   g = factorback(fa);
     251          35 :   return gc_upto(av, s < 0? gneg(g): g);
     252             : }
     253             : GEN
     254      220351 : nfnorm(GEN nf, GEN x)
     255             : {
     256      220351 :   pari_sp av = avma;
     257             :   GEN c, den;
     258             :   long n;
     259      220351 :   nf = checknf(nf);
     260      220351 :   n = nf_get_degree(nf);
     261      220351 :   if (typ(x) == t_MAT) return famat_norm(nf, x);
     262      220316 :   x = nf_to_scalar_or_basis(nf, x);
     263      220314 :   if (typ(x)!=t_COL)
     264      123767 :     return gc_upto(av, gpowgs(x, n));
     265       96547 :   x = nf_to_scalar_or_alg(nf, Q_primitive_part(x, &c));
     266       96548 :   x = Q_remove_denom(x, &den);
     267       96548 :   x = ZX_resultant_all(nf_get_pol(nf), x, den, 0);
     268       96549 :   return gc_upto(av, c ? gmul(x, gpowgs(c, n)): x);
     269             : }
     270             : 
     271             : static GEN
     272         119 : to_RgX(GEN P, long vx)
     273             : {
     274         119 :   return varn(P) == vx ? P: scalarpol_shallow(P, vx);
     275             : }
     276             : 
     277             : GEN
     278         462 : rnfeltnorm(GEN rnf, GEN x)
     279             : {
     280         462 :   pari_sp av = avma;
     281             :   GEN nf, pol;
     282             :   long v;
     283         462 :   checkrnf(rnf);
     284         455 :   v = rnf_get_varn(rnf);
     285             :   /* avoid rnfabstorel special t_POL case misinterpretation */
     286         455 :   if (typ(x) == t_POL && varn(x) == v) x = gmodulo(x, rnf_get_pol(rnf));
     287         455 :   x = liftpol_shallow(rnfeltabstorel(rnf, x));
     288         245 :   nf = rnf_get_nf(rnf); pol = rnf_get_pol(rnf);
     289         490 :   x = (typ(x) == t_POL)
     290         119 :     ? rnfeltdown(rnf, nfX_resultant(nf,pol,to_RgX(x,v)))
     291         245 :     : gpowgs(x, rnf_get_degree(rnf));
     292         245 :   return gc_upto(av, x);
     293             : }
     294             : 
     295             : /* x + y in nf */
     296             : GEN
     297    14282123 : nfadd(GEN nf, GEN x, GEN y)
     298             : {
     299    14282123 :   pari_sp av = avma;
     300             :   GEN z;
     301             : 
     302    14282123 :   nf = checknf(nf);
     303    14282123 :   x = nf_to_scalar_or_basis(nf, x);
     304    14282123 :   y = nf_to_scalar_or_basis(nf, y);
     305    14282123 :   if (typ(x) != t_COL)
     306    11157057 :   { z = (typ(y) == t_COL)? RgC_Rg_add(y, x): gadd(x,y); }
     307             :   else
     308     3125066 :   { z = (typ(y) == t_COL)? RgC_add(x, y): RgC_Rg_add(x, y); }
     309    14282123 :   return gc_upto(av, z);
     310             : }
     311             : /* x - y in nf */
     312             : GEN
     313     1432539 : nfsub(GEN nf, GEN x, GEN y)
     314             : {
     315     1432539 :   pari_sp av = avma;
     316             :   GEN z;
     317             : 
     318     1432539 :   nf = checknf(nf);
     319     1432539 :   x = nf_to_scalar_or_basis(nf, x);
     320     1432539 :   y = nf_to_scalar_or_basis(nf, y);
     321     1432539 :   if (typ(x) != t_COL)
     322     1172325 :   { z = (typ(y) == t_COL)? Rg_RgC_sub(x,y): gsub(x,y); }
     323             :   else
     324      260214 :   { z = (typ(y) == t_COL)? RgC_sub(x,y): RgC_Rg_sub(x,y); }
     325     1432539 :   return gc_upto(av, z);
     326             : }
     327             : 
     328             : /* product of ZC x,y in (true) nf; ( sum_i x_i sum_j y_j m^{i,j}_k )_k */
     329             : static GEN
     330     8238274 : nfmuli_ZC(GEN nf, GEN x, GEN y)
     331             : {
     332             :   long i, j, k, N;
     333     8238274 :   GEN TAB = get_tab(nf, &N), v = cgetg(N+1,t_COL);
     334             : 
     335    41419766 :   for (k = 1; k <= N; k++)
     336             :   {
     337    33181607 :     pari_sp av = avma;
     338    33181607 :     GEN s, TABi = TAB;
     339    33181607 :     if (k == 1)
     340     8238254 :       s = mulii(gel(x,1),gel(y,1));
     341             :     else
     342    24943247 :       s = addii(mulii(gel(x,1),gel(y,k)),
     343    24943353 :                 mulii(gel(x,k),gel(y,1)));
     344   223160124 :     for (i=2; i<=N; i++)
     345             :     {
     346   189982507 :       GEN t, xi = gel(x,i);
     347   189982507 :       TABi += N;
     348   189982507 :       if (!signe(xi)) continue;
     349             : 
     350    94546527 :       t = NULL;
     351  1081318564 :       for (j=2; j<=N; j++)
     352             :       {
     353   986774207 :         GEN p1, c = gcoeff(TABi, k, j); /* m^{i,j}_k */
     354   986774207 :         if (!signe(c)) continue;
     355   290110900 :         p1 = _mulii(c, gel(y,j));
     356   290115475 :         t = t? addii(t, p1): p1;
     357             :       }
     358    94544357 :       if (t) s = addii(s, mulii(xi, t));
     359             :     }
     360    33177617 :     gel(v,k) = gc_INT(av,s);
     361             :   }
     362     8238159 :   return v;
     363             : }
     364             : static int
     365    54061199 : is_famat(GEN x) { return typ(x) == t_MAT && lg(x) == 3; }
     366             : /* product of x and y in nf */
     367             : GEN
     368    24578585 : nfmul(GEN nf, GEN x, GEN y)
     369             : {
     370             :   GEN z;
     371    24578585 :   pari_sp av = avma;
     372             : 
     373    24578585 :   if (x == y) return nfsqr(nf,x);
     374             : 
     375    23323699 :   nf = checknf(nf);
     376    23323700 :   if (is_famat(x) || is_famat(y)) return famat_mul(x, y);
     377    23323391 :   x = nf_to_scalar_or_basis(nf, x);
     378    23323391 :   y = nf_to_scalar_or_basis(nf, y);
     379    23323390 :   if (typ(x) != t_COL)
     380             :   {
     381    16513540 :     if (isintzero(x)) return gen_0;
     382    13757870 :     z = (typ(y) == t_COL)? RgC_Rg_mul(y, x): gmul(x,y); }
     383             :   else
     384             :   {
     385     6809850 :     if (typ(y) != t_COL)
     386             :     {
     387     1892552 :       if (isintzero(y)) return gen_0;
     388     1047571 :       z = RgC_Rg_mul(x, y);
     389             :     }
     390             :     else
     391             :     {
     392             :       GEN dx, dy;
     393     4917298 :       x = Q_remove_denom(x, &dx);
     394     4917298 :       y = Q_remove_denom(y, &dy);
     395     4917297 :       z = nfmuli_ZC(nf,x,y);
     396     4917294 :       dx = mul_denom(dx,dy);
     397     4917294 :       if (dx) z = ZC_Z_div(z, dx);
     398             :     }
     399             :   }
     400    19722734 :   return gc_upto(av, z);
     401             : }
     402             : /* square of ZC x in nf */
     403             : static GEN
     404     7341988 : nfsqri_ZC(GEN nf, GEN x)
     405             : {
     406             :   long i, j, k, N;
     407     7341988 :   GEN TAB = get_tab(nf, &N), v = cgetg(N+1,t_COL);
     408             : 
     409    39726025 :   for (k = 1; k <= N; k++)
     410             :   {
     411    32384146 :     pari_sp av = avma;
     412    32384146 :     GEN s, TABi = TAB;
     413    32384146 :     if (k == 1)
     414     7342114 :       s = sqri(gel(x,1));
     415             :     else
     416    25042032 :       s = shifti(mulii(gel(x,1),gel(x,k)), 1);
     417   255175144 :     for (i=2; i<=N; i++)
     418             :     {
     419   222812432 :       GEN p1, c, t, xi = gel(x,i);
     420   222812432 :       TABi += N;
     421   222812432 :       if (!signe(xi)) continue;
     422             : 
     423    80575862 :       c = gcoeff(TABi, k, i);
     424    80575862 :       t = signe(c)? _mulii(c,xi): NULL;
     425   677102938 :       for (j=i+1; j<=N; j++)
     426             :       {
     427   596527752 :         c = gcoeff(TABi, k, j);
     428   596527752 :         if (!signe(c)) continue;
     429   232298773 :         p1 = _mulii(c, shifti(gel(x,j),1));
     430   232304885 :         t = t? addii(t, p1): p1;
     431             :       }
     432    80575186 :       if (t) s = addii(s, mulii(xi, t));
     433             :     }
     434    32362712 :     gel(v,k) = gc_INT(av,s);
     435             :   }
     436     7341879 :   return v;
     437             : }
     438             : /* square of x in nf */
     439             : GEN
     440     6108193 : nfsqr(GEN nf, GEN x)
     441             : {
     442     6108193 :   pari_sp av = avma;
     443             :   GEN z;
     444             : 
     445     6108193 :   nf = checknf(nf);
     446     6108195 :   if (is_famat(x)) return famat_sqr(x);
     447     6108196 :   x = nf_to_scalar_or_basis(nf, x);
     448     6108197 :   if (typ(x) != t_COL) z = gsqr(x);
     449             :   else
     450             :   {
     451             :     GEN dx;
     452     2643759 :     x = Q_remove_denom(x, &dx);
     453     2643763 :     z = nfsqri_ZC(nf,x);
     454     2643768 :     if (dx) z = RgC_Rg_div(z, sqri(dx));
     455             :   }
     456     6108205 :   return gc_upto(av, z);
     457             : }
     458             : 
     459             : /* x a ZC, v a t_COL of ZC/Z */
     460             : GEN
     461      194463 : zkC_multable_mul(GEN v, GEN x)
     462             : {
     463      194463 :   long i, l = lg(v);
     464      194463 :   GEN y = cgetg(l, t_COL);
     465      761683 :   for (i = 1; i < l; i++)
     466             :   {
     467      567220 :     GEN c = gel(v,i);
     468      567220 :     if (typ(c)!=t_COL) {
     469           0 :       if (!isintzero(c)) c = ZC_Z_mul(gel(x,1), c);
     470             :     } else {
     471      567220 :       c = ZM_ZC_mul(x,c);
     472      567220 :       if (ZV_isscalar(c)) c = gel(c,1);
     473             :     }
     474      567220 :     gel(y,i) = c;
     475             :   }
     476      194463 :   return y;
     477             : }
     478             : 
     479             : GEN
     480       31375 : nfC_multable_mul(GEN v, GEN x)
     481             : {
     482       31375 :   long i, l = lg(v);
     483       31375 :   GEN y = cgetg(l, t_COL);
     484      210577 :   for (i = 1; i < l; i++)
     485             :   {
     486      179202 :     GEN c = gel(v,i);
     487      179202 :     if (typ(c)!=t_COL) {
     488      141601 :       if (!isintzero(c)) c = RgC_Rg_mul(gel(x,1), c);
     489             :     } else {
     490       37601 :       c = RgM_RgC_mul(x,c);
     491       37601 :       if (QV_isscalar(c)) c = gel(c,1);
     492             :     }
     493      179202 :     gel(y,i) = c;
     494             :   }
     495       31375 :   return y;
     496             : }
     497             : 
     498             : GEN
     499      114287 : nfC_nf_mul(GEN nf, GEN v, GEN x)
     500             : {
     501             :   long tx;
     502             :   GEN y;
     503             : 
     504      114287 :   x = nf_to_scalar_or_basis(nf, x);
     505      114287 :   tx = typ(x);
     506      114287 :   if (tx != t_COL)
     507             :   {
     508             :     long l, i;
     509       85240 :     if (tx == t_INT)
     510             :     {
     511       81419 :       long s = signe(x);
     512       81419 :       if (!s) return zerocol(lg(v)-1);
     513       76479 :       if (is_pm1(x)) return s > 0? leafcopy(v): RgC_neg(v);
     514             :     }
     515       27215 :     l = lg(v); y = cgetg(l, t_COL);
     516      199154 :     for (i=1; i < l; i++)
     517             :     {
     518      171939 :       GEN c = gel(v,i);
     519      171939 :       if (typ(c) != t_COL) c = gmul(c, x); else c = RgC_Rg_mul(c, x);
     520      171939 :       gel(y,i) = c;
     521             :     }
     522       27215 :     return y;
     523             :   }
     524             :   else
     525             :   {
     526             :     GEN dx;
     527       29047 :     x = zk_multable(nf, Q_remove_denom(x,&dx));
     528       29047 :     y = nfC_multable_mul(v, x);
     529       29047 :     return dx? RgC_Rg_div(y, dx): y;
     530             :   }
     531             : }
     532             : static GEN
     533        7223 : mulbytab(GEN M, GEN c)
     534        7223 : { return typ(c) == t_COL? RgM_RgC_mul(M,c): RgC_Rg_mul(gel(M,1), c); }
     535             : GEN
     536        2037 : tablemulvec(GEN M, GEN x, GEN v)
     537             : {
     538             :   long l, i;
     539             :   GEN y;
     540             : 
     541        2037 :   if (typ(x) == t_COL && RgV_isscalar(x))
     542             :   {
     543           0 :     x = gel(x,1);
     544           0 :     return typ(v) == t_POL? RgX_Rg_mul(v,x): RgV_Rg_mul(v,x);
     545             :   }
     546        2037 :   x = multable(M, x); /* multiplication table by x */
     547        2037 :   y = cgetg_copy(v, &l);
     548        2037 :   if (typ(v) == t_POL)
     549             :   {
     550        2037 :     y[1] = v[1];
     551        9260 :     for (i=2; i < l; i++) gel(y,i) = mulbytab(x, gel(v,i));
     552        2037 :     y = normalizepol(y);
     553             :   }
     554             :   else
     555             :   {
     556           0 :     for (i=1; i < l; i++) gel(y,i) = mulbytab(x, gel(v,i));
     557             :   }
     558        2037 :   return y;
     559             : }
     560             : 
     561             : GEN
     562     1326437 : zkmultable_capZ(GEN mx) { return Q_denom(zkmultable_inv(mx)); }
     563             : GEN
     564     1635871 : zkmultable_inv(GEN mx) { return ZM_gauss(mx, col_ei(lg(mx)-1,1)); }
     565             : /* nf a true nf, x a ZC */
     566             : GEN
     567      309441 : zk_inv(GEN nf, GEN x) { return zkmultable_inv(zk_multable(nf,x)); }
     568             : 
     569             : /* inverse of x in nf */
     570             : GEN
     571      188805 : nfinv(GEN nf, GEN x)
     572             : {
     573      188805 :   pari_sp av = avma;
     574             :   GEN z;
     575             : 
     576      188805 :   nf = checknf(nf);
     577      188805 :   if (is_famat(x)) return famat_inv(x);
     578      188805 :   x = nf_to_scalar_or_basis(nf, x);
     579      188805 :   if (typ(x) == t_COL)
     580             :   {
     581             :     GEN d;
     582      173141 :     x = Q_remove_denom(x, &d);
     583      173141 :     z = zk_inv(nf, x);
     584      173141 :     if (d) z = RgC_Rg_mul(z, d);
     585             :   }
     586             :   else
     587       15664 :     z = ginv(x);
     588      188805 :   return gc_upto(av, z);
     589             : }
     590             : 
     591             : /* quotient of x and y in nf */
     592             : GEN
     593       40279 : nfdiv(GEN nf, GEN x, GEN y)
     594             : {
     595       40279 :   pari_sp av = avma;
     596             :   GEN z;
     597             : 
     598       40279 :   nf = checknf(nf);
     599       40279 :   if (is_famat(x) || is_famat(y)) return famat_div(x,y);
     600       40188 :   y = nf_to_scalar_or_basis(nf, y);
     601       40188 :   if (typ(y) != t_COL)
     602             :   {
     603       19887 :     x = nf_to_scalar_or_basis(nf, x);
     604       19887 :     z = (typ(x) == t_COL)? RgC_Rg_div(x, y): gdiv(x,y);
     605             :   }
     606             :   else
     607             :   {
     608             :     GEN d;
     609       20301 :     y = Q_remove_denom(y, &d);
     610       20301 :     z = nfmul(nf, x, zk_inv(nf,y));
     611       20301 :     if (d) z = typ(z) == t_COL? RgC_Rg_mul(z, d): gmul(z, d);
     612             :   }
     613       40188 :   return gc_upto(av, z);
     614             : }
     615             : 
     616             : /* product of INTEGERS (t_INT or ZC) x and y in (true) nf */
     617             : GEN
     618     4801641 : nfmuli(GEN nf, GEN x, GEN y)
     619             : {
     620     4801641 :   if (typ(x) == t_INT) return (typ(y) == t_COL)? ZC_Z_mul(y, x): mulii(x,y);
     621     3576139 :   if (typ(y) == t_INT) return ZC_Z_mul(x, y);
     622     3320935 :   return nfmuli_ZC(nf, x, y);
     623             : }
     624             : GEN
     625     4698287 : nfsqri(GEN nf, GEN x)
     626     4698287 : { return (typ(x) == t_INT)? sqri(x): nfsqri_ZC(nf, x); }
     627             : 
     628             : /* both x and y are RgV */
     629             : GEN
     630           0 : tablemul(GEN TAB, GEN x, GEN y)
     631             : {
     632             :   long i, j, k, N;
     633             :   GEN s, v;
     634           0 :   if (typ(x) != t_COL) return gmul(x, y);
     635           0 :   if (typ(y) != t_COL) return gmul(y, x);
     636           0 :   N = lg(x)-1;
     637           0 :   v = cgetg(N+1,t_COL);
     638           0 :   for (k=1; k<=N; k++)
     639             :   {
     640           0 :     pari_sp av = avma;
     641           0 :     GEN TABi = TAB;
     642           0 :     if (k == 1)
     643           0 :       s = gmul(gel(x,1),gel(y,1));
     644             :     else
     645           0 :       s = gadd(gmul(gel(x,1),gel(y,k)),
     646           0 :                gmul(gel(x,k),gel(y,1)));
     647           0 :     for (i=2; i<=N; i++)
     648             :     {
     649           0 :       GEN t, xi = gel(x,i);
     650           0 :       TABi += N;
     651           0 :       if (gequal0(xi)) continue;
     652             : 
     653           0 :       t = NULL;
     654           0 :       for (j=2; j<=N; j++)
     655             :       {
     656           0 :         GEN p1, c = gcoeff(TABi, k, j); /* m^{i,j}_k */
     657           0 :         if (gequal0(c)) continue;
     658           0 :         p1 = gmul(c, gel(y,j));
     659           0 :         t = t? gadd(t, p1): p1;
     660             :       }
     661           0 :       if (t) s = gadd(s, gmul(xi, t));
     662             :     }
     663           0 :     gel(v,k) = gc_upto(av,s);
     664             :   }
     665           0 :   return v;
     666             : }
     667             : GEN
     668       10356 : tablesqr(GEN TAB, GEN x)
     669             : {
     670             :   long i, j, k, N;
     671             :   GEN s, v;
     672             : 
     673       10356 :   if (typ(x) != t_COL) return gsqr(x);
     674       10356 :   N = lg(x)-1;
     675       10356 :   v = cgetg(N+1,t_COL);
     676             : 
     677       83106 :   for (k=1; k<=N; k++)
     678             :   {
     679       72750 :     pari_sp av = avma;
     680       72750 :     GEN TABi = TAB;
     681       72750 :     if (k == 1)
     682       10356 :       s = gsqr(gel(x,1));
     683             :     else
     684       62394 :       s = gmul2n(gmul(gel(x,1),gel(x,k)), 1);
     685      558276 :     for (i=2; i<=N; i++)
     686             :     {
     687      485526 :       GEN p1, c, t, xi = gel(x,i);
     688      485526 :       TABi += N;
     689      485526 :       if (gequal0(xi)) continue;
     690             : 
     691      140138 :       c = gcoeff(TABi, k, i);
     692      140138 :       t = !gequal0(c)? gmul(c,xi): NULL;
     693      652832 :       for (j=i+1; j<=N; j++)
     694             :       {
     695      512694 :         c = gcoeff(TABi, k, j);
     696      512694 :         if (gequal0(c)) continue;
     697      248752 :         p1 = gmul(gmul2n(c,1), gel(x,j));
     698      248752 :         t = t? gadd(t, p1): p1;
     699             :       }
     700      140138 :       if (t) s = gadd(s, gmul(xi, t));
     701             :     }
     702       72750 :     gel(v,k) = gc_upto(av,s);
     703             :   }
     704       10356 :   return v;
     705             : }
     706             : 
     707             : static GEN
     708      395711 : _mul(void *data, GEN x, GEN y) { return nfmuli((GEN)data,x,y); }
     709             : static GEN
     710     1055642 : _sqr(void *data, GEN x) { return nfsqri((GEN)data,x); }
     711             : 
     712             : /* Compute z^n in nf, left-shift binary powering */
     713             : GEN
     714     1021570 : nfpow(GEN nf, GEN z, GEN n)
     715             : {
     716     1021570 :   pari_sp av = avma;
     717             :   long s;
     718             :   GEN x, cx;
     719             : 
     720     1021570 :   if (typ(n)!=t_INT) pari_err_TYPE("nfpow",n);
     721     1021570 :   nf = checknf(nf);
     722     1021568 :   s = signe(n); if (!s) return gen_1;
     723     1021568 :   if (is_famat(z)) return famat_pow(z, n);
     724      960930 :   x = nf_to_scalar_or_basis(nf, z);
     725      960935 :   if (typ(x) != t_COL) return powgi(x,n);
     726      835269 :   if (s < 0)
     727             :   { /* simplified nfinv */
     728             :     GEN d;
     729       46830 :     x = Q_remove_denom(x, &d);
     730       46830 :     x = zk_inv(nf, x);
     731       46831 :     x = primitive_part(x, &cx);
     732       46831 :     cx = mul_content(cx, d);
     733       46831 :     n = negi(n);
     734             :   }
     735             :   else
     736      788439 :     x = primitive_part(x, &cx);
     737      835251 :   x = gen_pow_i(x, n, (void*)nf, _sqr, _mul);
     738      835269 :   if (cx)
     739       48196 :     x = gc_upto(av, gmul(x, powgi(cx, n)));
     740             :   else
     741      787073 :     x = gc_GEN(av, x);
     742      835279 :   return x;
     743             : }
     744             : /* Compute z^n in nf, left-shift binary powering */
     745             : GEN
     746      370807 : nfpow_u(GEN nf, GEN z, ulong n)
     747             : {
     748      370807 :   pari_sp av = avma;
     749             :   GEN x, cx;
     750             : 
     751      370807 :   if (!n) return gen_1;
     752      370807 :   x = nf_to_scalar_or_basis(nf, z);
     753      370807 :   if (typ(x) != t_COL) return gpowgs(x,n);
     754      330007 :   x = primitive_part(x, &cx);
     755      330006 :   x = gen_powu_i(x, n, (void*)nf, _sqr, _mul);
     756      330007 :   if (cx)
     757             :   {
     758      113733 :     x = gmul(x, powgi(cx, utoipos(n)));
     759      113733 :     return gc_upto(av,x);
     760             :   }
     761      216274 :   return gc_GEN(av, x);
     762             : }
     763             : 
     764             : long
     765        1218 : nfissquare(GEN nf, GEN z, GEN *px)
     766             : {
     767        1218 :   pari_sp av = avma;
     768        1218 :   long v = fetch_var_higher();
     769             :   GEN R;
     770        1218 :   nf = checknf(nf);
     771        1218 :   if (nf_get_degree(nf) == 1)
     772             :   {
     773         210 :     z = algtobasis(nf, z);
     774         210 :     if (!issquareall(gel(z,1), px)) return gc_long(av, 0);
     775          21 :     if (px) *px = gc_upto(av, *px); else set_avma(av);
     776          21 :     return 1;
     777             :   }
     778        1008 :   z = nf_to_scalar_or_alg(nf, z);
     779        1008 :   R = nfroots(nf, deg2pol_shallow(gen_m1, gen_0, z, v));
     780        1008 :   delete_var(); if (lg(R) == 1) return gc_long(av, 0);
     781         567 :   if (px) *px = gc_GEN(av, nf_to_scalar_or_basis(nf, gel(R,1)));
     782          14 :   else set_avma(av);
     783         567 :   return 1;
     784             : }
     785             : 
     786             : long
     787       11708 : nfispower(GEN nf, GEN z, long n, GEN *px)
     788             : {
     789       11708 :   pari_sp av = avma;
     790       11708 :   long v = fetch_var_higher();
     791             :   GEN R;
     792       11708 :   nf = checknf(nf);
     793       11708 :   if (nf_get_degree(nf) == 1)
     794             :   {
     795         329 :     z = algtobasis(nf, z);
     796         329 :     if (!ispower(gel(z,1), stoi(n), px)) return gc_long(av, 0);
     797         147 :     if (px) *px = gc_upto(av, *px); else set_avma(av);
     798         147 :     return 1;
     799             :   }
     800       11379 :   if (n <= 0)
     801           0 :     pari_err_DOMAIN("nfeltispower","exponent","<=",gen_0,stoi(n));
     802       11379 :   z = nf_to_scalar_or_alg(nf, z);
     803       11379 :   if (n==1)
     804             :   {
     805           0 :     if (px) *px = gc_GEN(av, z);
     806           0 :     return 1;
     807             :   }
     808       11379 :   R = nfroots(nf, gsub(pol_xn(n, v), z));
     809       11379 :   delete_var(); if (lg(R) == 1) return gc_long(av, 0);
     810        3780 :   if (px) *px = gc_GEN(av, nf_to_scalar_or_basis(nf, gel(R,1)));
     811        3766 :   else set_avma(av);
     812        3780 :   return 1;
     813             : }
     814             : 
     815             : static GEN
     816          56 : idmulred(void *nf, GEN x, GEN y) { return idealmulred((GEN) nf, x, y); }
     817             : static GEN
     818         413 : idpowred(void *nf, GEN x, GEN n) { return idealpowred((GEN) nf, x, n); }
     819             : static GEN
     820       72020 : idmul(void *nf, GEN x, GEN y) { return idealmul((GEN) nf, x, y); }
     821             : static GEN
     822       87971 : idpow(void *nf, GEN x, GEN n) { return idealpow((GEN) nf, x, n); }
     823             : GEN
     824       94567 : idealfactorback(GEN nf, GEN L, GEN e, long red)
     825             : {
     826       94567 :   nf = checknf(nf);
     827       94567 :   if (red) return gen_factorback(L, e, (void*)nf, &idmulred, &idpowred, NULL);
     828       94210 :   if (!e && typ(L) == t_MAT && lg(L) == 3) { e = gel(L,2); L = gel(L,1); }
     829       94210 :   if (is_vec_t(typ(L)) && RgV_is_prV(L))
     830             :   { /* don't use gen_factorback since *= pr^v can be done more efficiently */
     831       73576 :     pari_sp av = avma;
     832       73576 :     long i, l = lg(L);
     833             :     GEN a;
     834       73576 :     if (!e) e = const_vec(l-1, gen_1);
     835       70713 :     else switch(typ(e))
     836             :     {
     837        7728 :       case t_VECSMALL: e = zv_to_ZV(e); break;
     838       62985 :       case t_VEC: case t_COL:
     839       62985 :         if (!RgV_is_ZV(e))
     840           0 :           pari_err_TYPE("factorback [not an exponent vector]", e);
     841       62985 :         break;
     842           0 :       default: pari_err_TYPE("idealfactorback", e);
     843             :     }
     844       73576 :     if (l != lg(e))
     845           0 :       pari_err_TYPE("factorback [not an exponent vector]", e);
     846       73576 :     if (l == 1 || ZV_equal0(e)) return gc_const(av, gen_1);
     847       23243 :     a = idealpow(nf, gel(L,1), gel(e,1));
     848      250478 :     for (i = 2; i < l; i++)
     849      227235 :       if (signe(gel(e,i))) a = idealmulpowprime(nf, a, gel(L,i), gel(e,i));
     850       23243 :     return gc_upto(av, a);
     851             :   }
     852       20634 :   return gen_factorback(L, e, (void*)nf, &idmul, &idpow, NULL);
     853             : }
     854             : static GEN
     855      349071 : eltmul(void *nf, GEN x, GEN y) { return nfmul((GEN) nf, x, y); }
     856             : static GEN
     857      498197 : eltpow(void *nf, GEN x, GEN n) { return nfpow((GEN) nf, x, n); }
     858             : GEN
     859      277191 : nffactorback(GEN nf, GEN L, GEN e)
     860      277191 : { return gen_factorback(L, e, (void*)checknf(nf), &eltmul, &eltpow, NULL); }
     861             : 
     862             : static GEN
     863      778543 : _nf_red(void *E, GEN x) { (void)E; return gcopy(x); }
     864             : 
     865             : static GEN
     866     3861892 : _nf_add(void *E, GEN x, GEN y) { return nfadd((GEN)E,x,y); }
     867             : 
     868             : static GEN
     869      204392 : _nf_neg(void *E, GEN x) { (void)E; return gneg(x); }
     870             : 
     871             : static GEN
     872     4502050 : _nf_mul(void *E, GEN x, GEN y) { return nfmul((GEN)E,x,y); }
     873             : 
     874             : static GEN
     875       13727 : _nf_inv(void *E, GEN x) { return nfinv((GEN)E,x); }
     876             : 
     877             : static GEN
     878        3353 : _nf_s(void *E, long x) { (void)E; return stoi(x); }
     879             : 
     880             : static const struct bb_field nf_field={_nf_red,_nf_add,_nf_mul,_nf_neg,
     881             :                                         _nf_inv,&gequal0,_nf_s };
     882             : 
     883       54830 : const struct bb_field *get_nf_field(void **E, GEN nf)
     884       54830 : { *E = (void*)nf; return &nf_field; }
     885             : 
     886             : GEN
     887          14 : nfM_det(GEN nf, GEN M)
     888             : {
     889             :   void *E;
     890          14 :   const struct bb_field *S = get_nf_field(&E, nf);
     891          14 :   return gen_det(M, E, S);
     892             : }
     893             : GEN
     894        3339 : nfM_inv(GEN nf, GEN M)
     895             : {
     896             :   void *E;
     897        3339 :   const struct bb_field *S = get_nf_field(&E, nf);
     898        3339 :   return gen_Gauss(M, matid(lg(M)-1), E, S);
     899             : }
     900             : 
     901             : GEN
     902           0 : nfM_ker(GEN nf, GEN M)
     903             : {
     904             :    void *E;
     905           0 :    const struct bb_field *S = get_nf_field(&E, nf);
     906           0 :    return gen_ker(M, 0, E, S);
     907             : }
     908             : 
     909             : GEN
     910        2948 : nfM_mul(GEN nf, GEN A, GEN B)
     911             : {
     912             :   void *E;
     913        2948 :   const struct bb_field *S = get_nf_field(&E, nf);
     914        2948 :   return gen_matmul(A, B, E, S);
     915             : }
     916             : GEN
     917       48529 : nfM_nfC_mul(GEN nf, GEN A, GEN B)
     918             : {
     919             :   void *E;
     920       48529 :   const struct bb_field *S = get_nf_field(&E, nf);
     921       48529 :   return gen_matcolmul(A, B, E, S);
     922             : }
     923             : 
     924             : /* valuation of integral x (ZV), with resp. to prime ideal pr */
     925             : long
     926    24302839 : ZC_nfvalrem(GEN x, GEN pr, GEN *newx)
     927             : {
     928    24302839 :   pari_sp av = avma;
     929             :   long i, v, l;
     930    24302839 :   GEN r, y, p = pr_get_p(pr), mul = pr_get_tau(pr);
     931             : 
     932             :   /* p inert */
     933    24302839 :   if (typ(mul) == t_INT) return newx? ZV_pvalrem(x, p, newx):ZV_pval(x, p);
     934    23301551 :   y = cgetg_copy(x, &l); /* will hold the new x */
     935    23301968 :   x = leafcopy(x);
     936    37531129 :   for(v=0;; v++)
     937             :   {
     938   143792173 :     for (i=1; i<l; i++)
     939             :     { /* is (x.b)[i] divisible by p ? */
     940   129557095 :       gel(y,i) = dvmdii(ZMrow_ZC_mul(mul,x,i),p,&r);
     941   129560979 :       if (r != gen_0) { if (newx) *newx = x; return v; }
     942             :     }
     943    14235078 :     swap(x, y);
     944    14235078 :     if (!newx && (v & 0xf) == 0xf) v += pr_get_e(pr) * ZV_pvalrem(x, p, &x);
     945    14235078 :     if (gc_needed(av,1))
     946             :     {
     947           0 :       if(DEBUGMEM>1) pari_warn(warnmem,"ZC_nfvalrem, v >= %ld", v);
     948           0 :       (void)gc_all(av, 2, &x, &y);
     949             :     }
     950             :   }
     951             : }
     952             : long
     953    19808822 : ZC_nfval(GEN x, GEN P)
     954    19808822 : { return ZC_nfvalrem(x, P, NULL); }
     955             : 
     956             : /* v_P(x) != 0, x a ZV. Simpler version of ZC_nfvalrem */
     957             : int
     958     1290378 : ZC_prdvd(GEN x, GEN P)
     959             : {
     960     1290378 :   pari_sp av = avma;
     961             :   long i, l;
     962     1290378 :   GEN p = pr_get_p(P), mul = pr_get_tau(P);
     963     1290391 :   if (typ(mul) == t_INT) return ZV_Z_dvd(x, p);
     964     1289824 :   l = lg(x);
     965     5191745 :   for (i=1; i<l; i++)
     966     4652547 :     if (!dvdii(ZMrow_ZC_mul(mul,x,i), p)) return gc_bool(av,0);
     967      539198 :   return gc_bool(av,1);
     968             : }
     969             : 
     970             : int
     971         357 : pr_equal(GEN P, GEN Q)
     972             : {
     973         357 :   GEN gQ, p = pr_get_p(P);
     974         357 :   long e = pr_get_e(P), f = pr_get_f(P), n;
     975         357 :   if (!equalii(p, pr_get_p(Q)) || e != pr_get_e(Q) || f != pr_get_f(Q))
     976         336 :     return 0;
     977          21 :   gQ = pr_get_gen(Q); n = lg(gQ)-1;
     978          21 :   if (2*e*f > n) return 1; /* room for only one such pr */
     979          14 :   return ZV_equal(pr_get_gen(P), gQ) || ZC_prdvd(gQ, P);
     980             : }
     981             : 
     982             : GEN
     983      420735 : famat_nfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
     984             : {
     985      420735 :   pari_sp av = avma;
     986      420735 :   GEN P = gel(x,1), E = gel(x,2), V = gen_0, y = NULL;
     987      420735 :   long l = lg(P), simplify = 0, i;
     988      420735 :   if (py) { *py = gen_1; y = cgetg(l, t_COL); }
     989             : 
     990     2259223 :   for (i = 1; i < l; i++)
     991             :   {
     992     1838488 :     GEN e = gel(E,i);
     993             :     long v;
     994     1838488 :     if (!signe(e))
     995             :     {
     996           7 :       if (py) gel(y,i) = gen_1;
     997           7 :       simplify = 1; continue;
     998             :     }
     999     1838481 :     v = nfvalrem(nf, gel(P,i), pr, py? &gel(y,i): NULL);
    1000     1838481 :     if (v == LONG_MAX) { set_avma(av); if (py) *py = gen_0; return mkoo(); }
    1001     1838481 :     V = addmulii(V, stoi(v), e);
    1002             :   }
    1003      420735 :   if (!py) V = gc_INT(av, V);
    1004             :   else
    1005             :   {
    1006          56 :     y = mkmat2(y, gel(x,2));
    1007          56 :     if (simplify) y = famat_remove_trivial(y);
    1008          56 :     (void)gc_all(av, 2, &V, &y); *py = y;
    1009             :   }
    1010      420735 :   return V;
    1011             : }
    1012             : long
    1013     5606149 : nfval(GEN nf, GEN x, GEN pr)
    1014             : {
    1015     5606149 :   pari_sp av = avma;
    1016             :   long w, e;
    1017             :   GEN cx, p;
    1018             : 
    1019     5606149 :   if (gequal0(x)) return LONG_MAX;
    1020     5593346 :   nf = checknf(nf);
    1021     5593341 :   checkprid(pr);
    1022     5593338 :   p = pr_get_p(pr);
    1023     5593337 :   e = pr_get_e(pr);
    1024     5593336 :   x = nf_to_scalar_or_basis(nf, x);
    1025     5593231 :   if (typ(x) != t_COL) return e*Q_pval(x,p);
    1026     2371321 :   x = Q_primitive_part(x, &cx);
    1027     2371387 :   w = ZC_nfval(x,pr);
    1028     2371296 :   if (cx) w += e*Q_pval(cx,p);
    1029     2371301 :   return gc_long(av,w);
    1030             : }
    1031             : 
    1032             : /* want to write p^v = uniformizer^(e*v) * z^v, z coprime to pr */
    1033             : /* z := tau^e / p^(e-1), algebraic integer coprime to pr; return z^v */
    1034             : static GEN
    1035      973413 : powp(GEN nf, GEN pr, long v)
    1036             : {
    1037             :   GEN b, z;
    1038             :   long e;
    1039      973413 :   if (!v) return gen_1;
    1040      446803 :   b = pr_get_tau(pr);
    1041      446803 :   if (typ(b) == t_INT) return gen_1;
    1042      131299 :   e = pr_get_e(pr);
    1043      131299 :   z = gel(b,1);
    1044      131299 :   if (e != 1) z = gdiv(nfpow_u(nf, z, e), powiu(pr_get_p(pr),e-1));
    1045      131299 :   if (v < 0) { v = -v; z = nfinv(nf, z); }
    1046      131299 :   if (v != 1) z = nfpow_u(nf, z, v);
    1047      131299 :   return z;
    1048             : }
    1049             : long
    1050     3662737 : nfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
    1051             : {
    1052     3662737 :   pari_sp av = avma;
    1053             :   long w, e;
    1054             :   GEN cx, p, t;
    1055             : 
    1056     3662737 :   if (!py) return nfval(nf,x,pr);
    1057     1810893 :   if (gequal0(x)) { *py = gen_0; return LONG_MAX; }
    1058     1810836 :   nf = checknf(nf);
    1059     1810835 :   checkprid(pr);
    1060     1810834 :   p = pr_get_p(pr);
    1061     1810833 :   e = pr_get_e(pr);
    1062     1810833 :   x = nf_to_scalar_or_basis(nf, x);
    1063     1810834 :   if (typ(x) != t_COL) {
    1064      557837 :     w = Q_pvalrem(x,p, py);
    1065      557837 :     if (!w) { *py = gc_GEN(av, x); return 0; }
    1066      349258 :     *py = gc_upto(av, gmul(powp(nf, pr, w), *py));
    1067      349258 :     return e*w;
    1068             :   }
    1069     1252997 :   x = Q_primitive_part(x, &cx);
    1070     1253004 :   w = ZC_nfvalrem(x,pr, py);
    1071     1252987 :   if (cx)
    1072             :   {
    1073      624155 :     long v = Q_pvalrem(cx,p, &t);
    1074      624155 :     *py = nfmul(nf, *py, gmul(powp(nf,pr,v), t));
    1075      624155 :     *py = gc_upto(av, *py);
    1076      624155 :     w += e*v;
    1077             :   }
    1078             :   else
    1079      628832 :     *py = gc_GEN(av, *py);
    1080     1253007 :   return w;
    1081             : }
    1082             : GEN
    1083       15015 : gpnfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
    1084             : {
    1085             :   long v;
    1086       15015 :   if (is_famat(x)) return famat_nfvalrem(nf, x, pr, py);
    1087       15008 :   v = nfvalrem(nf,x,pr,py);
    1088       15008 :   return v == LONG_MAX? mkoo(): stoi(v);
    1089             : }
    1090             : 
    1091             : GEN
    1092      225683 : basistoalg(GEN nf, GEN x)
    1093             : {
    1094             :   GEN T;
    1095             : 
    1096      225683 :   nf = checknf(nf);
    1097      225683 :   switch(typ(x))
    1098             :   {
    1099      142711 :     case t_COL: {
    1100      142711 :       pari_sp av = avma; x = nf_to_scalar_or_alg(nf, x);
    1101      142704 :       return gc_GEN(av, mkpolmod(x, nf_get_pol(nf)));
    1102             :     }
    1103       45563 :     case t_POLMOD:
    1104       45563 :       T = nf_get_pol(nf);
    1105       45563 :       if (!RgX_equal_var(T,gel(x,1)))
    1106           0 :         pari_err_MODULUS("basistoalg", T,gel(x,1));
    1107       45563 :       return gcopy(x);
    1108        4865 :     case t_POL:
    1109        4865 :       T = nf_get_pol(nf);
    1110        4865 :       if (varn(T) != varn(x)) pari_err_VAR("basistoalg",x,T);
    1111        4858 :       retmkpolmod(RgX_rem(x, T), ZX_copy(T));
    1112       32544 :     case t_INT:
    1113             :     case t_FRAC:
    1114       32544 :       T = nf_get_pol(nf);
    1115       32544 :       retmkpolmod(gcopy(x), ZX_copy(T));
    1116           0 :     default:
    1117           0 :       pari_err_TYPE("basistoalg",x);
    1118             :       return NULL; /* LCOV_EXCL_LINE */
    1119             :   }
    1120             : }
    1121             : 
    1122             : /* true nf, x a t_POL */
    1123             : static GEN
    1124     3474391 : pol_to_scalar_or_basis(GEN nf, GEN x)
    1125             : {
    1126     3474391 :   GEN T = nf_get_pol(nf);
    1127     3474391 :   long l = lg(x);
    1128     3474391 :   if (varn(x) != varn(T)) pari_err_VAR("nf_to_scalar_or_basis", x,T);
    1129     3474285 :   if (l >= lg(T)) { x = RgX_rem(x, T); l = lg(x); }
    1130     3474285 :   if (l == 2) return gen_0;
    1131     3010738 :   if (l == 3)
    1132             :   {
    1133      677301 :     x = gel(x,2);
    1134      677301 :     if (!is_rational_t(typ(x))) pari_err_TYPE("nf_to_scalar_or_basis",x);
    1135      677294 :     return x;
    1136             :   }
    1137     2333437 :   return poltobasis(nf,x);
    1138             : }
    1139             : /* Assume nf is a genuine nf. */
    1140             : GEN
    1141   123816308 : nf_to_scalar_or_basis(GEN nf, GEN x)
    1142             : {
    1143   123816308 :   switch(typ(x))
    1144             :   {
    1145    71108932 :     case t_INT: case t_FRAC:
    1146    71108932 :       return x;
    1147      525357 :     case t_POLMOD:
    1148      525357 :       x = checknfelt_mod(nf,x,"nf_to_scalar_or_basis");
    1149      525222 :       switch(typ(x))
    1150             :       {
    1151       37723 :         case t_INT: case t_FRAC: return x;
    1152      487499 :         case t_POL: return pol_to_scalar_or_basis(nf,x);
    1153             :       }
    1154           0 :       break;
    1155     2986891 :     case t_POL: return pol_to_scalar_or_basis(nf,x);
    1156    49199024 :     case t_COL:
    1157    49199024 :       if (lg(x)-1 != nf_get_degree(nf)) break;
    1158    49198740 :       return QV_isscalar(x)? gel(x,1): x;
    1159             :   }
    1160          96 :   pari_err_TYPE("nf_to_scalar_or_basis",x);
    1161             :   return NULL; /* LCOV_EXCL_LINE */
    1162             : }
    1163             : /* Let x be a polynomial with coefficients in Q or nf. Return the same
    1164             :  * polynomial with coefficients expressed as vectors (on the integral basis).
    1165             :  * No consistency checks, not memory-clean. */
    1166             : GEN
    1167       32876 : RgX_to_nfX(GEN nf, GEN x)
    1168      254312 : { pari_APPLY_pol_normalized(nf_to_scalar_or_basis(nf, gel(x,i))); }
    1169             : 
    1170             : /* Assume nf is a genuine nf. */
    1171             : GEN
    1172     7161518 : nf_to_scalar_or_alg(GEN nf, GEN x)
    1173             : {
    1174     7161518 :   switch(typ(x))
    1175             :   {
    1176     1920330 :     case t_INT: case t_FRAC:
    1177     1920330 :       return x;
    1178       93674 :     case t_POLMOD:
    1179       93674 :       x = checknfelt_mod(nf,x,"nf_to_scalar_or_alg");
    1180       93674 :       if (typ(x) != t_POL) return x;
    1181             :       /* fall through */
    1182             :     case t_POL:
    1183             :     {
    1184      100240 :       GEN T = nf_get_pol(nf);
    1185      100240 :       long l = lg(x);
    1186      100240 :       if (varn(x) != varn(T)) pari_err_VAR("nf_to_scalar_or_alg", x,T);
    1187      100240 :       if (l >= lg(T)) { x = RgX_rem(x, T); l = lg(x); }
    1188      100240 :       if (l == 2) return gen_0;
    1189      100170 :       if (l == 3) return gel(x,2);
    1190       98455 :       return x;
    1191             :     }
    1192     5140801 :     case t_COL:
    1193             :     {
    1194             :       GEN dx;
    1195     5140801 :       if (lg(x)-1 != nf_get_degree(nf)) break;
    1196    10179924 :       if (QV_isscalar(x)) return gel(x,1);
    1197     5039064 :       x = Q_remove_denom(x, &dx);
    1198     5039107 :       x = RgV_RgC_mul(nf_get_zkprimpart(nf), x);
    1199     5039131 :       dx = mul_denom(dx, nf_get_zkden(nf));
    1200     5039121 :       return gdiv(x,dx);
    1201             :     }
    1202             :   }
    1203          56 :   pari_err_TYPE("nf_to_scalar_or_alg",x);
    1204             :   return NULL; /* LCOV_EXCL_LINE */
    1205             : }
    1206             : 
    1207             : /* Assume nf is a genuine nf. */
    1208             : GEN
    1209     2133712 : nf_to_scalar_or_polmod(GEN nf, GEN x)
    1210             : {
    1211     2133712 :   x = nf_to_scalar_or_alg(nf, x);
    1212     2133712 :   if (typ(x) == t_POL && varn(x) == nf_get_varn(nf))
    1213      281029 :     x = mkpolmod(x, nf_get_pol(nf));
    1214     2133712 :   return x;
    1215             : }
    1216             : 
    1217             : /* gmul(A, RgX_to_RgC(x)), A t_MAT of compatible dimensions */
    1218             : GEN
    1219        1365 : RgM_RgX_mul(GEN A, GEN x)
    1220             : {
    1221        1365 :   long i, l = lg(x)-1;
    1222             :   GEN z;
    1223        1365 :   if (l == 1) return zerocol(nbrows(A));
    1224        1351 :   z = gmul(gel(x,2), gel(A,1));
    1225        2555 :   for (i = 2; i < l; i++)
    1226        1204 :     if (!gequal0(gel(x,i+1))) z = gadd(z, gmul(gel(x,i+1), gel(A,i)));
    1227        1351 :   return z;
    1228             : }
    1229             : GEN
    1230    10255010 : ZM_ZX_mul(GEN A, GEN x)
    1231             : {
    1232    10255010 :   long i, l = lg(x)-1;
    1233             :   GEN z;
    1234    10255010 :   if (l == 1) return zerocol(nbrows(A));
    1235    10253708 :   z = ZC_Z_mul(gel(A,1), gel(x,2));
    1236    32746673 :   for (i = 2; i < l ; i++)
    1237    22495911 :     if (signe(gel(x,i+1))) z = ZC_add(z, ZC_Z_mul(gel(A,i), gel(x,i+1)));
    1238    10250762 :   return z;
    1239             : }
    1240             : /* x a t_POL, nf a genuine nf. No garbage collecting. No check.  */
    1241             : GEN
    1242     9630589 : poltobasis(GEN nf, GEN x)
    1243             : {
    1244     9630589 :   GEN d, T = nf_get_pol(nf);
    1245     9630568 :   if (varn(x) != varn(T)) pari_err_VAR( "poltobasis", x,T);
    1246     9630435 :   if (degpol(x) >= degpol(T)) x = RgX_rem(x,T);
    1247     9630456 :   x = Q_remove_denom(x, &d);
    1248     9630625 :   if (!RgX_is_ZX(x)) pari_err_TYPE("poltobasis",x);
    1249     9630553 :   x = ZM_ZX_mul(nf_get_invzk(nf), x);
    1250     9628451 :   if (d) x = RgC_Rg_div(x, d);
    1251     9628485 :   return x;
    1252             : }
    1253             : 
    1254             : GEN
    1255      971808 : algtobasis(GEN nf, GEN x)
    1256             : {
    1257             :   pari_sp av;
    1258             : 
    1259      971808 :   nf = checknf(nf);
    1260      971806 :   switch(typ(x))
    1261             :   {
    1262      153560 :     case t_POLMOD:
    1263      153560 :       if (!RgX_equal_var(nf_get_pol(nf),gel(x,1)))
    1264           7 :         pari_err_MODULUS("algtobasis", nf_get_pol(nf),gel(x,1));
    1265      153553 :       x = gel(x,2);
    1266      153553 :       switch(typ(x))
    1267             :       {
    1268       12565 :         case t_INT:
    1269       12565 :         case t_FRAC: return scalarcol(x, nf_get_degree(nf));
    1270      140988 :         case t_POL:
    1271      140988 :           av = avma;
    1272      140988 :           return gc_upto(av,poltobasis(nf,x));
    1273             :       }
    1274           0 :       break;
    1275             : 
    1276      252246 :     case t_POL:
    1277      252246 :       av = avma;
    1278      252246 :       return gc_upto(av,poltobasis(nf,x));
    1279             : 
    1280       84458 :     case t_COL:
    1281       84458 :       if (!RgV_is_QV(x)) pari_err_TYPE("nfalgtobasis",x);
    1282       84450 :       if (lg(x)-1 != nf_get_degree(nf)) pari_err_DIM("nfalgtobasis");
    1283       84450 :       return gcopy(x);
    1284             : 
    1285      481538 :     case t_INT:
    1286      481538 :     case t_FRAC: return scalarcol(x, nf_get_degree(nf));
    1287             :   }
    1288           6 :   pari_err_TYPE("algtobasis",x);
    1289             :   return NULL; /* LCOV_EXCL_LINE */
    1290             : }
    1291             : 
    1292             : GEN
    1293       61264 : rnfbasistoalg(GEN rnf,GEN x)
    1294             : {
    1295       61264 :   const char *f = "rnfbasistoalg";
    1296             :   long lx, i;
    1297       61264 :   pari_sp av = avma;
    1298             :   GEN z, nf, R, T;
    1299             : 
    1300       61264 :   checkrnf(rnf);
    1301       61264 :   nf = rnf_get_nf(rnf);
    1302       61264 :   T = nf_get_pol(nf);
    1303       61264 :   R = QXQX_to_mod_shallow(rnf_get_pol(rnf), T);
    1304       61264 :   switch(typ(x))
    1305             :   {
    1306         875 :     case t_COL:
    1307         875 :       z = cgetg_copy(x, &lx);
    1308        2597 :       for (i=1; i<lx; i++)
    1309             :       {
    1310        1778 :         GEN c = nf_to_scalar_or_alg(nf, gel(x,i));
    1311        1722 :         if (typ(c) == t_POL) c = mkpolmod(c,T);
    1312        1722 :         gel(z,i) = c;
    1313             :       }
    1314         819 :       z = RgV_RgC_mul(gel(rnf_get_zk(rnf),1), z);
    1315         735 :       return gc_upto(av, gmodulo(z,R));
    1316             : 
    1317       37555 :     case t_POLMOD:
    1318       37555 :       x = polmod_nffix(f, rnf, x, 0);
    1319       37282 :       if (typ(x) != t_POL) break;
    1320       17549 :       retmkpolmod(RgX_copy(x), RgX_copy(R));
    1321        1841 :     case t_POL:
    1322        1841 :       if (varn(x) == varn(T)) { RgX_check_QX(x,f); x = gmodulo(x,T); break; }
    1323        1596 :       if (varn(x) == varn(R))
    1324             :       {
    1325        1540 :         x = RgX_nffix(f,nf_get_pol(nf),x,0);
    1326        1540 :         return gmodulo(x, R);
    1327             :       }
    1328          56 :       pari_err_VAR(f, x,R);
    1329             :   }
    1330       40915 :   retmkpolmod(scalarpol(x, varn(R)), RgX_copy(R));
    1331             : }
    1332             : 
    1333             : GEN
    1334        3213 : matbasistoalg(GEN nf,GEN x)
    1335             : {
    1336             :   long i, j, li, lx;
    1337        3213 :   GEN z = cgetg_copy(x, &lx);
    1338             : 
    1339        3213 :   if (lx == 1) return z;
    1340        3206 :   switch(typ(x))
    1341             :   {
    1342          91 :     case t_VEC: case t_COL:
    1343         371 :       for (i=1; i<lx; i++) gel(z,i) = basistoalg(nf, gel(x,i));
    1344          91 :       return z;
    1345        3115 :     case t_MAT: break;
    1346           0 :     default: pari_err_TYPE("matbasistoalg",x);
    1347             :   }
    1348        3115 :   li = lgcols(x);
    1349       10948 :   for (j=1; j<lx; j++)
    1350             :   {
    1351        7833 :     GEN c = cgetg(li,t_COL), xj = gel(x,j);
    1352        7833 :     gel(z,j) = c;
    1353       33313 :     for (i=1; i<li; i++) gel(c,i) = basistoalg(nf, gel(xj,i));
    1354             :   }
    1355        3115 :   return z;
    1356             : }
    1357             : 
    1358             : GEN
    1359       33195 : matalgtobasis(GEN nf,GEN x)
    1360             : {
    1361             :   long i, j, li, lx;
    1362       33195 :   GEN z = cgetg_copy(x, &lx);
    1363             : 
    1364       33195 :   if (lx == 1) return z;
    1365       32733 :   switch(typ(x))
    1366             :   {
    1367       32726 :     case t_VEC: case t_COL:
    1368       86184 :       for (i=1; i<lx; i++) gel(z,i) = algtobasis(nf, gel(x,i));
    1369       32719 :       return z;
    1370           7 :     case t_MAT: break;
    1371           0 :     default: pari_err_TYPE("matalgtobasis",x);
    1372             :   }
    1373           7 :   li = lgcols(x);
    1374          14 :   for (j=1; j<lx; j++)
    1375             :   {
    1376           7 :     GEN c = cgetg(li,t_COL), xj = gel(x,j);
    1377           7 :     gel(z,j) = c;
    1378          21 :     for (i=1; i<li; i++) gel(c,i) = algtobasis(nf, gel(xj,i));
    1379             :   }
    1380           7 :   return z;
    1381             : }
    1382             : GEN
    1383        6800 : RgM_to_nfM(GEN nf,GEN x)
    1384             : {
    1385             :   long i, j, li, lx;
    1386        6800 :   GEN z = cgetg_copy(x, &lx);
    1387             : 
    1388        6800 :   if (lx == 1) return z;
    1389        6800 :   li = lgcols(x);
    1390       43755 :   for (j=1; j<lx; j++)
    1391             :   {
    1392       36955 :     GEN c = cgetg(li,t_COL), xj = gel(x,j);
    1393       36955 :     gel(z,j) = c;
    1394      228983 :     for (i=1; i<li; i++) gel(c,i) = nf_to_scalar_or_basis(nf, gel(xj,i));
    1395             :   }
    1396        6800 :   return z;
    1397             : }
    1398             : GEN
    1399      112896 : RgC_to_nfC(GEN nf, GEN x)
    1400      661480 : { pari_APPLY_type(t_COL, nf_to_scalar_or_basis(nf, gel(x,i))) }
    1401             : 
    1402             : /* x a t_POLMOD, supposedly in rnf = K[z]/(T), K = Q[y]/(Tnf) */
    1403             : GEN
    1404      181329 : polmod_nffix(const char *f, GEN rnf, GEN x, int lift)
    1405      181329 : { return polmod_nffix2(f, rnf_get_nfpol(rnf), rnf_get_pol(rnf), x,lift); }
    1406             : GEN
    1407      181420 : polmod_nffix2(const char *f, GEN T, GEN R, GEN x, int lift)
    1408             : {
    1409      181420 :   if (RgX_equal_var(gel(x,1), R))
    1410             :   {
    1411      149408 :     x = gel(x,2);
    1412      149408 :     if (typ(x) == t_POL && varn(x) == varn(R))
    1413             :     {
    1414      116027 :       x = RgX_nffix(f, T, x, lift);
    1415      116027 :       switch(lg(x))
    1416             :       {
    1417        5831 :         case 2: return gen_0;
    1418       18786 :         case 3: return gel(x,2);
    1419             :       }
    1420       91410 :       return x;
    1421             :     }
    1422             :   }
    1423       65393 :   return Rg_nffix(f, T, x, lift);
    1424             : }
    1425             : GEN
    1426        1428 : rnfalgtobasis(GEN rnf,GEN x)
    1427             : {
    1428        1428 :   const char *f = "rnfalgtobasis";
    1429        1428 :   pari_sp av = avma;
    1430             :   GEN T, R;
    1431             : 
    1432        1428 :   checkrnf(rnf);
    1433        1428 :   R = rnf_get_pol(rnf);
    1434        1428 :   T = rnf_get_nfpol(rnf);
    1435        1428 :   switch(typ(x))
    1436             :   {
    1437          98 :     case t_COL:
    1438          98 :       if (lg(x)-1 != rnf_get_degree(rnf)) pari_err_DIM(f);
    1439          49 :       x = RgV_nffix(f, T, x, 0);
    1440          42 :       return gc_GEN(av, x);
    1441             : 
    1442        1162 :     case t_POLMOD:
    1443        1162 :       x = polmod_nffix(f, rnf, x, 0);
    1444        1057 :       if (typ(x) != t_POL) break;
    1445         714 :       return gc_upto(av, RgM_RgX_mul(rnf_get_invzk(rnf), x));
    1446         112 :     case t_POL:
    1447         112 :       if (varn(x) == varn(T))
    1448             :       {
    1449          42 :         RgX_check_QX(x,f);
    1450          28 :         if (degpol(x) >= degpol(T)) x = RgX_rem(x,T);
    1451          28 :         x = mkpolmod(x,T); break;
    1452             :       }
    1453          70 :       x = RgX_nffix(f, T, x, 0);
    1454          56 :       if (degpol(x) >= degpol(R)) x = RgX_rem(x, R);
    1455          56 :       return gc_upto(av, RgM_RgX_mul(rnf_get_invzk(rnf), x));
    1456             :   }
    1457         427 :   return gc_upto(av, scalarcol(x, rnf_get_degree(rnf)));
    1458             : }
    1459             : 
    1460             : /* Given a and b in nf, gives an algebraic integer y in nf such that a-b.y
    1461             :  * is "small" */
    1462             : GEN
    1463         259 : nfdiveuc(GEN nf, GEN a, GEN b)
    1464             : {
    1465         259 :   pari_sp av = avma;
    1466         259 :   a = nfdiv(nf,a,b);
    1467         259 :   return gc_upto(av, ground(a));
    1468             : }
    1469             : 
    1470             : /* Given a and b in nf, gives a "small" algebraic integer r in nf
    1471             :  * of the form a-b.y */
    1472             : GEN
    1473         259 : nfmod(GEN nf, GEN a, GEN b)
    1474             : {
    1475         259 :   pari_sp av = avma;
    1476         259 :   GEN p1 = gneg_i(nfmul(nf,b,ground(nfdiv(nf,a,b))));
    1477         259 :   return gc_upto(av, nfadd(nf,a,p1));
    1478             : }
    1479             : 
    1480             : /* Given a and b in nf, gives a two-component vector [y,r] in nf such
    1481             :  * that r=a-b.y is "small". */
    1482             : GEN
    1483         259 : nfdivrem(GEN nf, GEN a, GEN b)
    1484             : {
    1485         259 :   pari_sp av = avma;
    1486         259 :   GEN p1,z, y = ground(nfdiv(nf,a,b));
    1487             : 
    1488         259 :   p1 = gneg_i(nfmul(nf,b,y));
    1489         259 :   z = cgetg(3,t_VEC);
    1490         259 :   gel(z,1) = gcopy(y);
    1491         259 :   gel(z,2) = nfadd(nf,a,p1); return gc_upto(av, z);
    1492             : }
    1493             : 
    1494             : /*************************************************************************/
    1495             : /**                                                                     **/
    1496             : /**                   LOGARITHMIC EMBEDDINGS                            **/
    1497             : /**                                                                     **/
    1498             : /*************************************************************************/
    1499             : 
    1500             : static int
    1501     4733154 : low_prec(GEN x)
    1502             : {
    1503     4733154 :   switch(typ(x))
    1504             :   {
    1505           0 :     case t_INT: return !signe(x);
    1506     4733154 :     case t_REAL: return !signe(x) || realprec(x) <= DEFAULTPREC;
    1507           0 :     default: return 0;
    1508             :   }
    1509             : }
    1510             : 
    1511             : static GEN
    1512       23111 : cxlog_1(GEN nf) { return zerocol(lg(nf_get_roots(nf))-1); }
    1513             : static GEN
    1514         534 : cxlog_m1(GEN nf, long prec)
    1515             : {
    1516         534 :   long i, l = lg(nf_get_roots(nf)), r1 = nf_get_r1(nf);
    1517         534 :   GEN v = cgetg(l, t_COL), p,  P;
    1518         534 :   p = mppi(prec); P = mkcomplex(gen_0, p);
    1519        1237 :   for (i = 1; i <= r1; i++) gel(v,i) = P; /* IPi*/
    1520         534 :   if (i < l) P = gmul2n(P,1);
    1521        1126 :   for (     ; i < l; i++) gel(v,i) = P; /* 2IPi */
    1522         534 :   return v;
    1523             : }
    1524             : static GEN
    1525     1761213 : ZC_cxlog(GEN nf, GEN x, long prec)
    1526             : {
    1527             :   long i, l, r1;
    1528             :   GEN v;
    1529     1761213 :   x = RgM_RgC_mul(nf_get_M(nf), Q_primpart(x));
    1530     1761215 :   l = lg(x); r1 = nf_get_r1(nf);
    1531     4480655 :   for (i = 1; i <= r1; i++)
    1532     2719440 :     if (low_prec(gel(x,i))) return NULL;
    1533     3560850 :   for (     ; i <  l;  i++)
    1534     1799635 :     if (low_prec(gnorm(gel(x,i)))) return NULL;
    1535     1761215 :   v = cgetg(l,t_COL);
    1536     4480655 :   for (i = 1; i <= r1; i++) gel(v,i) = glog(gel(x,i),prec);
    1537     3560848 :   for (     ; i <  l;  i++) gel(v,i) = gmul2n(glog(gel(x,i),prec),1);
    1538     1761213 :   return v;
    1539             : }
    1540             : static GEN
    1541      223244 : famat_cxlog(GEN nf, GEN fa, long prec)
    1542             : {
    1543      223244 :   GEN G, E, y = NULL;
    1544             :   long i, l;
    1545             : 
    1546      223244 :   if (typ(fa) != t_MAT) pari_err_TYPE("famat_cxlog",fa);
    1547      223244 :   if (lg(fa) == 1) return cxlog_1(nf);
    1548      223244 :   G = gel(fa,1);
    1549      223244 :   E = gel(fa,2); l = lg(E);
    1550     1119749 :   for (i = 1; i < l; i++)
    1551             :   {
    1552      896506 :     GEN t, e = gel(E,i), x = nf_to_scalar_or_basis(nf, gel(G,i));
    1553             :     /* multiplicative arch would be better (save logs), but exponents overflow
    1554             :      * [ could keep track of expo separately, but not worth it ] */
    1555      896506 :     switch(typ(x))
    1556             :     { /* ignore positive rationals */
    1557       16426 :       case t_FRAC: x = gel(x,1); /* fall through */
    1558      266525 :       case t_INT: if (signe(x) > 0) continue;
    1559          86 :         if (!mpodd(e)) continue;
    1560          30 :         t = cxlog_m1(nf, prec); /* we probably should not reach this line */
    1561          30 :         break;
    1562      629981 :       default: /* t_COL */
    1563      629981 :         t = ZC_cxlog(nf,x,prec); if (!t) return NULL;
    1564      629981 :         t = RgC_Rg_mul(t, e);
    1565             :     }
    1566      630010 :     y = y? RgV_add(y,t): t;
    1567             :   }
    1568      223243 :   return y ? y: cxlog_1(nf);
    1569             : }
    1570             : /* Archimedean components: [e_i Log( sigma_i(X) )], where X = primpart(x),
    1571             :  * and e_i = 1 (resp 2.) for i <= R1 (resp. > R1) */
    1572             : GEN
    1573     1355624 : nf_cxlog(GEN nf, GEN x, long prec)
    1574             : {
    1575     1355624 :   if (typ(x) == t_MAT) return famat_cxlog(nf,x,prec);
    1576     1132380 :   x = nf_to_scalar_or_basis(nf,x);
    1577     1132380 :   switch(typ(x))
    1578             :   {
    1579           0 :     case t_FRAC: x = gel(x,1); /* fall through */
    1580        1148 :     case t_INT:
    1581        1148 :       return signe(x) > 0? cxlog_1(nf): cxlog_m1(nf, prec);
    1582     1131232 :     default:
    1583     1131232 :       return ZC_cxlog(nf, x, prec);
    1584             :   }
    1585             : }
    1586             : GEN
    1587          97 : nfV_cxlog(GEN nf, GEN x, long prec)
    1588             : {
    1589             :   long i, l;
    1590          97 :   GEN v = cgetg_copy(x, &l);
    1591         167 :   for (i = 1; i < l; i++)
    1592          70 :     if (!(gel(v,i) = nf_cxlog(nf, gel(x,i), prec))) return NULL;
    1593          97 :   return v;
    1594             : }
    1595             : 
    1596             : static GEN
    1597       15820 : scalar_logembed(GEN nf, GEN u, GEN *emb)
    1598             : {
    1599             :   GEN v, logu;
    1600       15820 :   long i, s = signe(u), RU = lg(nf_get_roots(nf))-1, R1 = nf_get_r1(nf);
    1601             : 
    1602       15820 :   if (!s) pari_err_DOMAIN("nflogembed","argument","=",gen_0,u);
    1603       15820 :   v = cgetg(RU+1, t_COL); logu = logr_abs(u);
    1604       18977 :   for (i = 1; i <= R1; i++) gel(v,i) = logu;
    1605       15820 :   if (i <= RU)
    1606             :   {
    1607       14350 :     GEN logu2 = shiftr(logu,1);
    1608       55839 :     for (   ; i <= RU; i++) gel(v,i) = logu2;
    1609             :   }
    1610       15820 :   if (emb) *emb = const_col(RU, u);
    1611       15820 :   return v;
    1612             : }
    1613             : 
    1614             : static GEN
    1615        1309 : famat_logembed(GEN nf,GEN x,GEN *emb,long prec)
    1616             : {
    1617        1309 :   GEN A, M, T, a, t, g = gel(x,1), e = gel(x,2);
    1618        1309 :   long i, l = lg(e);
    1619             : 
    1620        1309 :   if (l == 1) return scalar_logembed(nf, real_1(prec), emb);
    1621        1309 :   A = NULL; T = emb? cgetg(l, t_COL): NULL;
    1622        1309 :   if (emb) *emb = M = mkmat2(T, e);
    1623       62132 :   for (i = 1; i < l; i++)
    1624             :   {
    1625       60823 :     a = nflogembed(nf, gel(g,i), &t, prec);
    1626       60823 :     if (!a) return NULL;
    1627       60823 :     a = RgC_Rg_mul(a, gel(e,i));
    1628       60823 :     A = A? RgC_add(A, a): a;
    1629       60823 :     if (emb) gel(T,i) = t;
    1630             :   }
    1631        1309 :   return A;
    1632             : }
    1633             : 
    1634             : /* Get archimedean components: [e_i log( | sigma_i(x) | )], with e_i = 1
    1635             :  * (resp 2.) for i <= R1 (resp. > R1) and set emb to the embeddings of x.
    1636             :  * Return NULL if precision problem */
    1637             : GEN
    1638      107645 : nflogembed(GEN nf, GEN x, GEN *emb, long prec)
    1639             : {
    1640             :   long i, l, r1;
    1641             :   GEN v, t;
    1642             : 
    1643      107645 :   if (typ(x) == t_MAT) return famat_logembed(nf,x,emb,prec);
    1644      106336 :   x = nf_to_scalar_or_basis(nf,x);
    1645      106336 :   if (typ(x) != t_COL) return scalar_logembed(nf, gtofp(x,prec), emb);
    1646       90516 :   x = RgM_RgC_mul(nf_get_M(nf), x);
    1647       90517 :   l = lg(x); r1 = nf_get_r1(nf); v = cgetg(l,t_COL);
    1648      134610 :   for (i = 1; i <= r1; i++)
    1649             :   {
    1650       44093 :     t = gabs(gel(x,i),prec); if (low_prec(t)) return NULL;
    1651       44093 :     gel(v,i) = glog(t,prec);
    1652             :   }
    1653      260505 :   for (   ; i < l; i++)
    1654             :   {
    1655      169988 :     t = gnorm(gel(x,i)); if (low_prec(t)) return NULL;
    1656      169987 :     gel(v,i) = glog(t,prec);
    1657             :   }
    1658       90517 :   if (emb) *emb = x;
    1659       90517 :   return v;
    1660             : }
    1661             : 
    1662             : /*************************************************************************/
    1663             : /**                                                                     **/
    1664             : /**                        REAL EMBEDDINGS                              **/
    1665             : /**                                                                     **/
    1666             : /*************************************************************************/
    1667             : static GEN
    1668      512134 : sarch_get_cyc(GEN sarch) { return gel(sarch,1); }
    1669             : static GEN
    1670     1863262 : sarch_get_archp(GEN sarch) { return gel(sarch,2); }
    1671             : static GEN
    1672      730110 : sarch_get_MI(GEN sarch) { return gel(sarch,3); }
    1673             : static GEN
    1674      730110 : sarch_get_lambda(GEN sarch) { return gel(sarch,4); }
    1675             : static GEN
    1676      730109 : sarch_get_F(GEN sarch) { return gel(sarch,5); }
    1677             : 
    1678             : /* true nf, x non-zero algebraic integer; return number of positive real roots
    1679             :  * of char_x */
    1680             : static long
    1681     1163325 : num_positive(GEN nf, GEN x)
    1682             : {
    1683     1163325 :   GEN T = nf_get_pol(nf), B, charx;
    1684     1163323 :   long dnf, vnf, N, r1 = nf_get_r1(nf);
    1685     1163325 :   x = nf_to_scalar_or_alg(nf, x);
    1686     1163326 :   if (typ(x) != t_POL) return (signe(x) < 0)? 0: degpol(T);
    1687             :   /* x not a scalar */
    1688     1157879 :   if (r1 == 1)
    1689             :   {
    1690       31402 :     long s = signe(ZX_resultant(T, Q_primpart(x)));
    1691       31402 :     return s > 0? 1: 0;
    1692             :   }
    1693     1126477 :   charx = ZXQ_charpoly(x, T, 0);
    1694     1126475 :   charx = ZX_radical(charx);
    1695     1126472 :   N = degpol(T) / degpol(charx);
    1696             :   /* real places are unramified ? */
    1697     1126470 :   if (N == 1 || ZX_sturm(charx) * N == r1)
    1698     1125860 :     return ZX_sturmpart(charx, mkvec2(gen_0,mkoo())) * N;
    1699             :   /* painful case, multiply by random square until primitive */
    1700         610 :   dnf = nf_get_degree(nf);
    1701         610 :   vnf = varn(T);
    1702         610 :   B = int2n(10);
    1703             :   for(;;)
    1704           0 :   {
    1705         610 :     GEN y = RgXQ_sqr(random_FpX(dnf, vnf, B), T);
    1706         610 :     y = RgXQ_mul(x, y, T);
    1707         610 :     charx = ZXQ_charpoly(y, T, 0);
    1708         610 :     if (ZX_is_squarefree(charx))
    1709         610 :       return ZX_sturmpart(charx, mkvec2(gen_0,mkoo()));
    1710             :   }
    1711             : }
    1712             : 
    1713             : /* x a QC: return sigma_k(x) where 1 <= k <= r1+r2; correct but inefficient
    1714             :  * if x in Q. M = nf_get_M(nf) */
    1715             : static GEN
    1716        2140 : nfembed_i(GEN M, GEN x, long k)
    1717             : {
    1718        2140 :   long i, l = lg(M);
    1719        2140 :   GEN z = gel(x,1);
    1720       24380 :   for (i = 2; i < l; i++) z = gadd(z, gmul(gcoeff(M,k,i), gel(x,i)));
    1721        2140 :   return z;
    1722             : }
    1723             : GEN
    1724           0 : nfembed(GEN nf, GEN x, long k)
    1725             : {
    1726           0 :   pari_sp av = avma;
    1727           0 :   nf = checknf(nf);
    1728           0 :   x = nf_to_scalar_or_basis(nf,x);
    1729           0 :   if (typ(x) != t_COL) return gc_GEN(av, x);
    1730           0 :   return gc_upto(av, nfembed_i(nf_get_M(nf),x,k));
    1731             : }
    1732             : 
    1733             : /* x a ZC */
    1734             : static GEN
    1735      104183 : zk_embed(GEN M, GEN x, long k)
    1736             : {
    1737      104183 :   long i, l = lg(x);
    1738      104183 :   GEN z = gel(x,1); /* times M[k,1], which is 1 */
    1739      258089 :   for (i = 2; i < l; i++) z = mpadd(z, mpmul(gcoeff(M,k,i), gel(x,i)));
    1740      104183 :   return z;
    1741             : }
    1742             : 
    1743             : /* check that signs[i..#signs] == s; signs = NULL encodes "totally positive" */
    1744             : static int
    1745       34198 : oksigns(long l, GEN signs, long i, long s)
    1746             : {
    1747       34198 :   if (!signs) return s == 0;
    1748       40592 :   for (; i < l; i++)
    1749       30513 :     if (signs[i] != s) return 0;
    1750       10079 :   return 1;
    1751             : }
    1752             : 
    1753             : /* true nf, x a ZC (primitive for efficiency) which is not a scalar */
    1754             : static int
    1755      105788 : nfchecksigns_i(GEN nf, GEN x, GEN signs, GEN archp)
    1756             : {
    1757      105788 :   long i, np, npc, l = lg(archp), r1 = nf_get_r1(nf);
    1758             :   GEN sarch;
    1759             : 
    1760      105788 :   if (r1 == 0) return 1;
    1761      105403 :   np = num_positive(nf, x);
    1762      105403 :   if (np == 0)  return oksigns(l, signs, 1, 1);
    1763       89975 :   if (np == r1) return oksigns(l, signs, 1, 0);
    1764       71205 :   sarch = nfarchstar(nf, NULL, identity_perm(r1));
    1765       80389 :   for (i = 1, npc = 0; i < l; i++)
    1766             :   {
    1767       80139 :     GEN xi = set_sign_mod_divisor(nf, vecsmall_ei(r1, archp[i]), gen_1, sarch);
    1768             :     long ni, s;
    1769       80139 :     xi = Q_primpart(xi);
    1770       80139 :     ni = num_positive(nf, nfmuli(nf,x,xi));
    1771       80139 :     s = ni < np? 0: 1;
    1772       80139 :     if (s != (signs? signs[i]: 0)) return 0;
    1773       34924 :     if (!s) npc++; /* found a positive root */
    1774       34924 :     if (npc == np)
    1775             :     { /* found all positive roots */
    1776       25077 :       if (!signs) return i == l-1;
    1777       18213 :       for (i++; i < l; i++)
    1778        8885 :         if (signs[i] != 1) return 0;
    1779        9328 :       return 1;
    1780             :     }
    1781        9847 :     if (i - npc == r1 - np)
    1782             :     { /* found all negative roots */
    1783         663 :       if (!signs) return 1;
    1784         719 :       for (i++; i < l; i++)
    1785          77 :         if (signs[i]) return 0;
    1786         642 :       return 1;
    1787             :     }
    1788             :   }
    1789         250 :   return 1;
    1790             : }
    1791             : static void
    1792        1213 : pl_convert(GEN pl, GEN *psigns, GEN *parchp)
    1793             : {
    1794        1213 :   long i, j, l = lg(pl);
    1795        1213 :   GEN signs = cgetg(l, t_VECSMALL);
    1796        1213 :   GEN archp = cgetg(l, t_VECSMALL);
    1797        3921 :   for (i = j = 1; i < l; i++)
    1798             :   {
    1799        2708 :     if (!pl[i]) continue;
    1800        1926 :     archp[j] = i;
    1801        1926 :     signs[j] = (pl[i] < 0)? 1: 0;
    1802        1926 :     j++;
    1803             :   }
    1804        1213 :   setlg(archp, j); *parchp = archp;
    1805        1213 :   setlg(signs, j); *psigns = signs;
    1806        1213 : }
    1807             : /* pl : requested signs for real embeddings, 0 = no sign constraint */
    1808             : int
    1809       14499 : nfchecksigns(GEN nf, GEN x, GEN pl)
    1810             : {
    1811       14499 :   pari_sp av = avma;
    1812             :   GEN signs, archp;
    1813       14499 :   nf = checknf(nf);
    1814       14499 :   x = nf_to_scalar_or_basis(nf,x);
    1815       14499 :   if (typ(x) != t_COL)
    1816             :   {
    1817       13286 :     long i, l = lg(pl), s = gsigne(x);
    1818       24332 :     for (i = 1; i < l; i++)
    1819       13349 :       if (pl[i] && pl[i] != s) return gc_bool(av,0);
    1820       10983 :     return gc_bool(av,1);
    1821             :   }
    1822        1213 :   pl_convert(pl, &signs, &archp);
    1823        1213 :   return gc_bool(av, nfchecksigns_i(nf, x, signs, archp));
    1824             : }
    1825             : 
    1826             : /* signs = NULL: totally positive, else sign[i] = 0 (+) or 1 (-) */
    1827             : static GEN
    1828      730111 : get_C(GEN lambda, long l, GEN signs)
    1829             : {
    1830             :   long i;
    1831             :   GEN C, mlambda;
    1832      730111 :   if (!signs) return const_vec(l-1, lambda);
    1833      700361 :   C = cgetg(l, t_COL); mlambda = gneg(lambda);
    1834     2715932 :   for (i = 1; i < l; i++) gel(C,i) = signs[i]? mlambda: lambda;
    1835      700362 :   return C;
    1836             : }
    1837             : /* signs = NULL: totally positive at archp.
    1838             :  * Assume that a t_COL x is not a scalar */
    1839             : static GEN
    1840      864028 : nfsetsigns(GEN nf, GEN signs, GEN x, GEN sarch)
    1841             : {
    1842      864028 :   long i, l = lg(sarch_get_archp(sarch));
    1843      864031 :   GEN ex = NULL;
    1844             :   /* Is signature already correct ? */
    1845      864031 :   if (typ(x) != t_COL)
    1846             :   {
    1847      759459 :     long s = gsigne(x);
    1848      759457 :     if (!s) i = 1;
    1849      759436 :     else if (!signs)
    1850        7399 :       i = (s < 0)? 1: l;
    1851             :     else
    1852             :     {
    1853      752037 :       s = s < 0? 1: 0;
    1854     1285768 :       for (i = 1; i < l; i++)
    1855     1194493 :         if (signs[i] != s) break;
    1856             :     }
    1857      759457 :     if (i < l) ex = const_col(l-1, x);
    1858             :   }
    1859             :   else
    1860             :   { /* inefficient if x scalar, wrong if x = 0 */
    1861      104572 :     pari_sp av = avma;
    1862      104572 :     GEN cex, M = nf_get_M(nf), archp = sarch_get_archp(sarch);
    1863      104575 :     GEN xp = Q_primitive_part(x,&cex);
    1864      104575 :     if (nfchecksigns_i(nf, xp, signs, archp)) set_avma(av);
    1865             :     else
    1866             :     {
    1867       69186 :       ex = cgetg(l,t_COL);
    1868      173369 :       for (i = 1; i < l; i++) gel(ex,i) = zk_embed(M,xp,archp[i]);
    1869       69186 :       if (cex) ex = RgC_Rg_mul(ex, cex); /* put back content */
    1870             :     }
    1871             :   }
    1872      864023 :   if (ex)
    1873             :   { /* If no, fix it */
    1874      730110 :     GEN MI = sarch_get_MI(sarch), F = sarch_get_F(sarch);
    1875      730110 :     GEN lambda = sarch_get_lambda(sarch);
    1876      730111 :     GEN t = RgC_sub(get_C(lambda, l, signs), ex);
    1877      730118 :     t = grndtoi(RgM_RgC_mul(MI,t), NULL);
    1878      730101 :     if (lg(F) != 1) t = ZM_ZC_mul(F, t);
    1879      730107 :     x = typ(x) == t_COL? RgC_add(t, x): RgC_Rg_add(t, x);
    1880             :   }
    1881      864013 :   return x;
    1882             : }
    1883             : /* - true nf
    1884             :  * - sarch = nfarchstar(nf, F);
    1885             :  * - x encodes a vector of signs at arch.archp: either a t_VECSMALL
    1886             :  *   (vector of signs as {0,1}-vector), NULL (totally positive at archp),
    1887             :  *   or a nonzero number field element (replaced by its signature at archp);
    1888             :  * - y is a nonzero number field element
    1889             :  * Return z = y (mod F) with signs(y, archp) = signs(x) (a {0,1}-vector).
    1890             :  * Not stack-clean */
    1891             : GEN
    1892      894672 : set_sign_mod_divisor(GEN nf, GEN x, GEN y, GEN sarch)
    1893             : {
    1894      894672 :   GEN archp = sarch_get_archp(sarch);
    1895      894672 :   if (lg(archp) == 1) return y;
    1896      861779 :   if (x && typ(x) != t_VECSMALL) x = nfsign_arch(nf, x, archp);
    1897      861779 :   return nfsetsigns(nf, x, nf_to_scalar_or_basis(nf,y), sarch);
    1898             : }
    1899             : 
    1900             : static GEN
    1901      480456 : setsigns_init(GEN nf, GEN archp, GEN F, GEN DATA)
    1902             : {
    1903      480456 :   GEN lambda, Mr = rowpermute(nf_get_M(nf), archp), MI = F? RgM_mul(Mr,F): Mr;
    1904      480460 :   lambda = gmul2n(matrixnorm(MI,DEFAULTPREC), -1);
    1905      480460 :   if (typ(lambda) != t_REAL) lambda = gmul(lambda, uutoQ(1001,1000));
    1906      480464 :   if (lg(archp) < lg(MI))
    1907             :   {
    1908       81853 :     GEN perm = gel(indexrank(MI), 2);
    1909       81853 :     if (!F) F = matid(nf_get_degree(nf));
    1910       81853 :     MI = vecpermute(MI, perm);
    1911       81853 :     F = vecpermute(F, perm);
    1912             :   }
    1913      480464 :   if (!F) F = cgetg(1,t_MAT);
    1914      480465 :   MI = RgM_inv(MI);
    1915      480464 :   return mkvec5(DATA, archp, MI, lambda, F);
    1916             : }
    1917             : /* F nonzero integral ideal in HNF (or NULL: Z_K), compute elements in 1+F
    1918             :  * whose sign matrix at archp is identity; archp in 'indices' format */
    1919             : GEN
    1920      658760 : nfarchstar(GEN nf, GEN F, GEN archp)
    1921             : {
    1922      658760 :   long nba = lg(archp) - 1;
    1923      658760 :   if (!nba) return mkvec2(cgetg(1,t_VEC), archp);
    1924      478215 :   if (F && equali1(gcoeff(F,1,1))) F = NULL;
    1925      478215 :   if (F) F = idealpseudored(F, nf_get_roundG(nf));
    1926      478200 :   return setsigns_init(nf, archp, F, const_vec(nba, gen_2));
    1927             : }
    1928             : 
    1929             : /*************************************************************************/
    1930             : /**                                                                     **/
    1931             : /**                         IDEALCHINESE                                **/
    1932             : /**                                                                     **/
    1933             : /*************************************************************************/
    1934             : static int
    1935        6218 : isprfact(GEN x)
    1936             : {
    1937             :   long i, l;
    1938             :   GEN L, E;
    1939        6218 :   if (typ(x) != t_MAT || lg(x) != 3) return 0;
    1940        6218 :   L = gel(x,1); l = lg(L);
    1941        6218 :   E = gel(x,2);
    1942       19015 :   for(i=1; i<l; i++)
    1943             :   {
    1944       12797 :     checkprid(gel(L,i));
    1945       12797 :     if (typ(gel(E,i)) != t_INT) return 0;
    1946             :   }
    1947        6218 :   return 1;
    1948             : }
    1949             : 
    1950             : /* initialize projectors mod pr[i]^e[i] for idealchinese */
    1951             : static GEN
    1952        6218 : pr_init(GEN nf, GEN fa, GEN w, GEN dw)
    1953             : {
    1954        6218 :   GEN U, E, F, FZ, L = gel(fa,1), E0 = gel(fa,2);
    1955        6218 :   long i, r = lg(L);
    1956             : 
    1957        6218 :   if (w && lg(w) != r) pari_err_TYPE("idealchinese", w);
    1958        6218 :   if (r == 1 && !dw) return cgetg(1,t_VEC);
    1959        6204 :   E = leafcopy(E0); /* do not destroy fa[2] */
    1960       19001 :   for (i = 1; i < r; i++)
    1961       12797 :     if (signe(gel(E,i)) < 0) gel(E,i) = gen_0;
    1962        6204 :   F = factorbackprime(nf, L, E);
    1963        6204 :   if (dw)
    1964             :   {
    1965         693 :     F = ZM_Z_mul(F, dw);
    1966        1596 :     for (i = 1; i < r; i++)
    1967             :     {
    1968         903 :       GEN pr = gel(L,i);
    1969         903 :       long e = itos(gel(E0,i)), v = idealval(nf, dw, pr);
    1970         903 :       if (e >= 0)
    1971         896 :         gel(E,i) = addiu(gel(E,i), v);
    1972           7 :       else if (v + e <= 0)
    1973           0 :         F = idealmulpowprime(nf, F, pr, stoi(-v)); /* coprime to pr */
    1974             :       else
    1975             :       {
    1976           7 :         F = idealmulpowprime(nf, F, pr, stoi(e));
    1977           7 :         gel(E,i) = stoi(v + e);
    1978             :       }
    1979             :     }
    1980             :   }
    1981        6204 :   U = cgetg(r, t_VEC);
    1982       19001 :   for (i = 1; i < r; i++)
    1983             :   {
    1984             :     GEN u;
    1985       12797 :     if (w && gequal0(gel(w,i))) u = gen_0; /* unused */
    1986             :     else
    1987             :     {
    1988       12720 :       GEN pr = gel(L,i), e = gel(E,i), t;
    1989       12720 :       t = idealdivpowprime(nf,F, pr, e);
    1990       12720 :       u = hnfmerge_get_1(t, idealpow(nf, pr, e));
    1991       12720 :       if (!u) pari_err_COPRIME("idealchinese", t,pr);
    1992             :     }
    1993       12797 :     gel(U,i) = u;
    1994             :   }
    1995        6204 :   FZ = gcoeff(F, 1, 1);
    1996        6204 :   F = idealpseudored(F, nf_get_roundG(nf));
    1997        6204 :   return mkvec2(mkvec2(F, FZ), U);
    1998             : }
    1999             : 
    2000             : static GEN
    2001        2996 : pl_normalize(GEN nf, GEN pl)
    2002             : {
    2003        2996 :   const char *fun = "idealchinese";
    2004        2996 :   if (lg(pl)-1 != nf_get_r1(nf)) pari_err_TYPE(fun,pl);
    2005        2996 :   switch(typ(pl))
    2006             :   {
    2007         707 :     case t_VEC: RgV_check_ZV(pl,fun); pl = ZV_to_zv(pl);
    2008             :       /* fall through */
    2009        2996 :     case t_VECSMALL: break;
    2010           0 :     default: pari_err_TYPE(fun,pl);
    2011             :   }
    2012        2996 :   return pl;
    2013             : }
    2014             : 
    2015             : static int
    2016       13267 : is_chineseinit(GEN x)
    2017             : {
    2018             :   GEN fa, pl;
    2019             :   long l;
    2020       13267 :   if (typ(x) != t_VEC || lg(x)!=3) return 0;
    2021       10705 :   fa = gel(x,1);
    2022       10705 :   pl = gel(x,2);
    2023       10705 :   if (typ(fa) != t_VEC || typ(pl) != t_VEC) return 0;
    2024        6561 :   l = lg(fa);
    2025        6561 :   if (l != 1)
    2026             :   {
    2027             :     GEN z;
    2028        6519 :     if (l != 3) return 0;
    2029        6519 :     z = gel(fa, 1);
    2030        6519 :     if (typ(z) != t_VEC || lg(z) != 3 || typ(gel(z,1)) != t_MAT
    2031        6512 :                         || typ(gel(z,2)) != t_INT
    2032        6512 :                         || typ(gel(fa,2)) != t_VEC)
    2033           7 :       return 0;
    2034             :   }
    2035        6554 :   l = lg(pl);
    2036        6554 :   if (l != 1)
    2037             :   {
    2038        1136 :     if (l != 6 || typ(gel(pl,3)) != t_MAT || typ(gel(pl,1)) != t_VECSMALL
    2039        1136 :                                           || typ(gel(pl,2)) != t_VECSMALL)
    2040           0 :       return 0;
    2041             :   }
    2042        6554 :   return 1;
    2043             : }
    2044             : 
    2045             : /* nf a true 'nf' */
    2046             : static GEN
    2047        6687 : chineseinit_i(GEN nf, GEN fa, GEN w, GEN dw)
    2048             : {
    2049        6687 :   const char *fun = "idealchineseinit";
    2050        6687 :   GEN archp = NULL, pl = NULL;
    2051        6687 :   switch(typ(fa))
    2052             :   {
    2053        2996 :     case t_VEC:
    2054        2996 :       if (is_chineseinit(fa))
    2055             :       {
    2056           0 :         if (dw) pari_err_DOMAIN(fun, "denom(y)", "!=", gen_1, w);
    2057           0 :         return fa;
    2058             :       }
    2059        2996 :       if (lg(fa) != 3) pari_err_TYPE(fun, fa);
    2060             :       /* of the form [x,s] */
    2061        2996 :       pl = pl_normalize(nf, gel(fa,2));
    2062        2996 :       fa = gel(fa,1);
    2063        2996 :       archp = vecsmall01_to_indices(pl);
    2064             :       /* keep pr_init, reset pl */
    2065        2996 :       if (is_chineseinit(fa)) { fa = gel(fa,1); break; }
    2066             :       /* fall through */
    2067             :     case t_MAT: /* factorization? */
    2068        6218 :       if (isprfact(fa)) { fa = pr_init(nf, fa, w, dw); break; }
    2069           0 :     default: pari_err_TYPE(fun,fa);
    2070             :   }
    2071             : 
    2072        6687 :   if (!pl) pl = cgetg(1,t_VEC);
    2073             :   else
    2074             :   {
    2075        2996 :     long r = lg(archp);
    2076        2996 :     if (r == 1) pl = cgetg(1, t_VEC);
    2077             :     else
    2078             :     {
    2079        2242 :       GEN F = (lg(fa) == 1)? NULL: gmael(fa,1,1), signs = cgetg(r, t_VECSMALL);
    2080             :       long i;
    2081        6234 :       for (i = 1; i < r; i++) signs[i] = (pl[archp[i]] < 0)? 1: 0;
    2082        2242 :       pl = setsigns_init(nf, archp, F, signs);
    2083             :     }
    2084             :   }
    2085        6687 :   return mkvec2(fa, pl);
    2086             : }
    2087             : 
    2088             : /* Given a prime ideal factorization x, possibly with 0 or negative exponents,
    2089             :  * and a vector w of elements of nf, gives b such that
    2090             :  * v_p(b-w_p)>=v_p(x) for all prime ideals p in the ideal factorization
    2091             :  * and v_p(b)>=0 for all other p, using the standard proof given in GTM 138. */
    2092             : GEN
    2093       12779 : idealchinese(GEN nf, GEN x0, GEN w)
    2094             : {
    2095       12779 :   const char *fun = "idealchinese";
    2096       12779 :   pari_sp av = avma;
    2097       12779 :   GEN x = x0, x1, x2, s, dw, F;
    2098             : 
    2099       12779 :   nf = checknf(nf);
    2100       12779 :   if (!w) return gc_GEN(av, chineseinit_i(nf,x,NULL,NULL));
    2101             : 
    2102        7282 :   if (typ(w) != t_VEC) pari_err_TYPE(fun,w);
    2103        7282 :   w = Q_remove_denom(matalgtobasis(nf,w), &dw);
    2104        7275 :   if (!is_chineseinit(x)) x = chineseinit_i(nf,x,w,dw);
    2105             :   /* x is a 'chineseinit' */
    2106        7275 :   x1 = gel(x,1); s = NULL;
    2107        7275 :   x2 = gel(x,2);
    2108        7275 :   if (lg(x1) == 1) { F = NULL; dw = NULL; }
    2109             :   else
    2110             :   {
    2111        7233 :     GEN  U = gel(x1,2), FZ;
    2112        7233 :     long i, r = lg(w);
    2113        7233 :     F = gmael(x1,1,1); FZ = gmael(x1,1,2);
    2114       23691 :     for (i=1; i<r; i++)
    2115       16458 :       if (!ZV_equal0(gel(w,i)))
    2116             :       {
    2117       12335 :         GEN t = nfmuli(nf, gel(U,i), gel(w,i));
    2118       12335 :         s = s? ZC_add(s,t): t;
    2119             :       }
    2120        7233 :     if (s)
    2121             :     {
    2122        7212 :       s = ZC_reducemodmatrix(s, F);
    2123        7212 :       if (dw && x == x0) /* input was a chineseinit */
    2124             :       {
    2125           7 :         dw = modii(dw, FZ);
    2126           7 :         s = FpC_Fp_mul(s, Fp_inv(dw, FZ), FZ);
    2127           7 :         dw = NULL;
    2128             :       }
    2129        7212 :       if (ZV_isscalar(s)) s = icopy(gel(s,1));
    2130             :     }
    2131             :   }
    2132        7275 :   if (lg(x2) != 1)
    2133             :   {
    2134        2249 :     s = nfsetsigns(nf, gel(x2,1), s? s: gen_0, x2);
    2135        2249 :     if (typ(s) == t_COL && QV_isscalar(s))
    2136             :     {
    2137         434 :       s = gel(s,1); if (!dw) s = gcopy(s);
    2138             :     }
    2139             :   }
    2140        5026 :   else if (!s) return gc_const(av, gen_0);
    2141        7226 :   return gc_upto(av, dw? gdiv(s, dw): s);
    2142             : }
    2143             : 
    2144             : /*************************************************************************/
    2145             : /**                                                                     **/
    2146             : /**                           (Z_K/I)^*                                 **/
    2147             : /**                                                                     **/
    2148             : /*************************************************************************/
    2149             : GEN
    2150        2996 : vecsmall01_to_indices(GEN v)
    2151             : {
    2152        2996 :   long i, k, l = lg(v);
    2153        2996 :   GEN p = new_chunk(l) + l;
    2154        8449 :   for (k=1, i=l-1; i; i--)
    2155        5453 :     if (v[i]) { *--p = i; k++; }
    2156        2996 :   *--p = _evallg(k) | evaltyp(t_VECSMALL);
    2157        2996 :   set_avma((pari_sp)p); return p;
    2158             : }
    2159             : GEN
    2160     1325704 : vec01_to_indices(GEN v)
    2161             : {
    2162             :   long i, k, l;
    2163             :   GEN p;
    2164             : 
    2165     1325704 :   switch (typ(v))
    2166             :   {
    2167     1265889 :    case t_VECSMALL: return v;
    2168       59815 :    case t_VEC: break;
    2169           0 :    default: pari_err_TYPE("vec01_to_indices",v);
    2170             :   }
    2171       59815 :   l = lg(v);
    2172       59815 :   p = new_chunk(l) + l;
    2173      180131 :   for (k=1, i=l-1; i; i--)
    2174      120316 :     if (signe(gel(v,i))) { *--p = i; k++; }
    2175       59815 :   *--p = _evallg(k) | evaltyp(t_VECSMALL);
    2176       59815 :   set_avma((pari_sp)p); return p;
    2177             : }
    2178             : GEN
    2179      143703 : indices_to_vec01(GEN p, long r)
    2180             : {
    2181      143703 :   long i, l = lg(p);
    2182      143703 :   GEN v = zerovec(r);
    2183      217823 :   for (i = 1; i < l; i++) gel(v, p[i]) = gen_1;
    2184      143701 :   return v;
    2185             : }
    2186             : 
    2187             : /* return (column) vector of R1 signatures of x (0 or 1) */
    2188             : GEN
    2189     1265889 : nfsign_arch(GEN nf, GEN x, GEN arch)
    2190             : {
    2191     1265889 :   GEN sarch, V, archp = vec01_to_indices(arch);
    2192     1265891 :   long i, s, np, npc, r1, n = lg(archp)-1;
    2193             :   pari_sp av;
    2194             : 
    2195     1265891 :   if (!n) return cgetg(1,t_VECSMALL);
    2196     1063680 :   if (typ(x) == t_MAT)
    2197             :   { /* factorisation */
    2198      337495 :     GEN g = gel(x,1), e = gel(x,2);
    2199      337495 :     long l = lg(g);
    2200      337495 :     V = zero_zv(n);
    2201      953574 :     for (i = 1; i < l; i++)
    2202      616078 :       if (mpodd(gel(e,i)))
    2203      503564 :         Flv_add_inplace(V, nfsign_arch(nf,gel(g,i),archp), 2);
    2204      337496 :     set_avma((pari_sp)V); return V;
    2205             :   }
    2206      726185 :   av = avma; V = cgetg(n+1,t_VECSMALL);
    2207      726185 :   x = nf_to_scalar_or_basis(nf, x);
    2208      726185 :   switch(typ(x))
    2209             :   {
    2210      202186 :     case t_INT:
    2211      202186 :       s = signe(x);
    2212      202186 :       if (!s) pari_err_DOMAIN("nfsign_arch","element","=",gen_0,x);
    2213      202186 :       set_avma(av); return const_vecsmall(n, (s < 0)? 1: 0);
    2214         644 :     case t_FRAC:
    2215         644 :       s = signe(gel(x,1));
    2216         644 :       set_avma(av); return const_vecsmall(n, (s < 0)? 1: 0);
    2217             :   }
    2218      523355 :   r1 = nf_get_r1(nf); x = Q_primpart(x); np = num_positive(nf, x);
    2219      523354 :   if (np == 0) { set_avma(av); return const_vecsmall(n, 1); }
    2220      461505 :   if (np == r1){ set_avma(av); return const_vecsmall(n, 0); }
    2221      315572 :   sarch = nfarchstar(nf, NULL, identity_perm(r1));
    2222      455797 :   for (i = 1, npc = 0; i <= n; i++)
    2223             :   {
    2224      454438 :     GEN xi = set_sign_mod_divisor(nf, vecsmall_ei(r1, archp[i]), gen_1, sarch);
    2225             :     long ni;
    2226      454436 :     xi = Q_primpart(xi);
    2227      454439 :     ni = num_positive(nf, nfmuli(nf,x,xi));
    2228      454439 :     V[i] = ni < np? 0: 1;
    2229      454439 :     if (!V[i]) npc++; /* found a positive root */
    2230      454439 :     if (npc == np)
    2231             :     { /* found all positive roots */
    2232      324927 :       for (i++; i <= n; i++) V[i] = 1;
    2233      179603 :       break;
    2234             :     }
    2235      274836 :     if (i - npc == r1 - np)
    2236             :     { /* found all negative roots */
    2237      210801 :       for (i++; i <= n; i++) V[i] = 0;
    2238      134610 :       break;
    2239             :     }
    2240             :   }
    2241      315572 :   set_avma((pari_sp)V); return V;
    2242             : }
    2243             : static void
    2244       37121 : chk_ind(const char *s, long i, long r1)
    2245             : {
    2246       37121 :   if (i <= 0) pari_err_DOMAIN(s, "index", "<=", gen_0, stoi(i));
    2247       37107 :   if (i > r1) pari_err_DOMAIN(s, "index", ">", utoi(r1), utoi(i));
    2248       37072 : }
    2249             : static GEN
    2250      129059 : parse_embed(GEN ind, long r, const char *f)
    2251             : {
    2252             :   long l, i;
    2253      129059 :   if (!ind) return identity_perm(r);
    2254       34755 :   switch(typ(ind))
    2255             :   {
    2256          70 :     case t_INT: ind = mkvecsmall(itos(ind)); break;
    2257          84 :     case t_VEC: case t_COL: ind = vec_to_vecsmall(ind); break;
    2258       34601 :     case t_VECSMALL: break;
    2259           0 :     default: pari_err_TYPE(f, ind);
    2260             :   }
    2261       34755 :   l = lg(ind);
    2262       71827 :   for (i = 1; i < l; i++) chk_ind(f, ind[i], r);
    2263       34706 :   return ind;
    2264             : }
    2265             : GEN
    2266      126175 : nfeltsign(GEN nf, GEN x, GEN ind0)
    2267             : {
    2268      126175 :   pari_sp av = avma;
    2269             :   long i, l;
    2270             :   GEN v, ind;
    2271      126175 :   nf = checknf(nf);
    2272      126175 :   ind = parse_embed(ind0, nf_get_r1(nf), "nfeltsign");
    2273      126154 :   l = lg(ind);
    2274      126154 :   if (is_rational_t(typ(x)))
    2275             :   { /* nfsign_arch would test this, but avoid converting t_VECSMALL -> t_VEC */
    2276             :     GEN s;
    2277       31913 :     switch(gsigne(x))
    2278             :     {
    2279       16625 :       case -1:s = gen_m1; break;
    2280       15281 :       case 1: s = gen_1; break;
    2281           7 :       default: s = gen_0; break;
    2282             :     }
    2283       31913 :     set_avma(av);
    2284       31913 :     return (ind0 && typ(ind0) == t_INT)? s: const_vec(l-1, s);
    2285             :   }
    2286       94241 :   v = nfsign_arch(nf, x, ind);
    2287       94241 :   if (ind0 && typ(ind0) == t_INT) { set_avma(av); return v[1]? gen_m1: gen_1; }
    2288       94227 :   settyp(v, t_VEC);
    2289      264264 :   for (i = 1; i < l; i++) gel(v,i) = v[i]? gen_m1: gen_1;
    2290       94227 :   return gc_upto(av, v);
    2291             : }
    2292             : 
    2293             : /* true nf */
    2294             : GEN
    2295         728 : nfeltembed_i(GEN *pnf, GEN x, GEN ind0, long prec0)
    2296             : {
    2297             :   long i, e, l, r1, r2, prec, prec1;
    2298         728 :   GEN v, ind, cx, nf = *pnf;
    2299         728 :   nf_get_sign(nf,&r1,&r2);
    2300         728 :   x = nf_to_scalar_or_basis(nf, x);
    2301         721 :   ind = parse_embed(ind0, r1+r2, "nfeltembed");
    2302         714 :   l = lg(ind);
    2303         714 :   if (typ(x) != t_COL)
    2304             :   {
    2305         224 :     if (!(ind0 && typ(ind0) == t_INT)) x = const_vec(l-1, x);
    2306         224 :     return x;
    2307             :   }
    2308         490 :   x = Q_primitive_part(x, &cx);
    2309         490 :   prec1 = prec0; e = gexpo(x);
    2310         490 :   if (e > 8) prec1 += nbits2extraprec(e);
    2311         490 :   prec = prec1;
    2312         490 :   if (nf_get_prec(nf) < prec) nf = nfnewprec_shallow(nf, prec);
    2313         490 :   v = cgetg(l, t_VEC);
    2314             :   for(;;)
    2315         138 :   {
    2316         628 :     GEN M = nf_get_M(nf);
    2317        2630 :     for (i = 1; i < l; i++)
    2318             :     {
    2319        2140 :       GEN t = nfembed_i(M, x, ind[i]);
    2320        2140 :       long e = gexpo(t);
    2321        2140 :       if (gequal0(t) || precision(t) < prec0
    2322        2140 :                      || (e < 0 && prec < prec1 + nbits2extraprec(-e)) ) break;
    2323        2002 :       if (cx) t = gmul(t, cx);
    2324        2002 :       gel(v,i) = t;
    2325             :     }
    2326         628 :     if (i == l) break;
    2327         138 :     prec = precdbl(prec);
    2328         138 :     if (DEBUGLEVEL>1) pari_warn(warnprec,"eltnfembed", prec);
    2329         138 :     *pnf = nf = nfnewprec_shallow(nf, prec);
    2330             :   }
    2331         490 :   if (ind0 && typ(ind0) == t_INT) v = gel(v,1);
    2332         490 :   return v;
    2333             : }
    2334             : GEN
    2335         728 : nfeltembed(GEN nf, GEN x, GEN ind0, long prec0)
    2336             : {
    2337         728 :   pari_sp av = avma; nf = checknf(nf);
    2338         728 :   return gc_GEN(av, nfeltembed_i(&nf, x, ind0, prec0));
    2339             : }
    2340             : 
    2341             : /* number of distinct roots of sigma(f) */
    2342             : GEN
    2343        2163 : nfpolsturm(GEN nf, GEN f, GEN ind0)
    2344             : {
    2345        2163 :   pari_sp av = avma;
    2346             :   long d, l, r1, single;
    2347             :   GEN ind, u, v, vr1, T, s, t;
    2348             : 
    2349        2163 :   nf = checknf(nf); T = nf_get_pol(nf); r1 = nf_get_r1(nf);
    2350        2163 :   ind = parse_embed(ind0, r1, "nfpolsturm");
    2351        2142 :   single = ind0 && typ(ind0) == t_INT;
    2352        2142 :   l = lg(ind);
    2353             : 
    2354        2142 :   if (gequal0(f)) pari_err_ROOTS0("nfpolsturm");
    2355        2135 :   if (typ(f) == t_POL && varn(f) != varn(T))
    2356             :   {
    2357        2114 :     f = RgX_nffix("nfpolsturm", T, f,1);
    2358        2114 :     if (lg(f) == 3) f = NULL;
    2359             :   }
    2360             :   else
    2361             :   {
    2362          21 :     (void)Rg_nffix("nfpolsturm", T, f, 0);
    2363          21 :     f = NULL;
    2364             :   }
    2365        2135 :   if (!f) { set_avma(av); return single? gen_0: zerovec(l-1); }
    2366        2114 :   d = degpol(f);
    2367        2114 :   if (d == 1) { set_avma(av); return single? gen_1: const_vec(l-1,gen_1); }
    2368             : 
    2369        2023 :   vr1 = const_vecsmall(l-1, 1);
    2370        2023 :   u = Q_primpart(f); s = ZV_to_zv(nfeltsign(nf, gel(u,d+2), ind));
    2371        2023 :   v = RgX_deriv(u); t = odd(d)? leafcopy(s): zv_neg(s);
    2372             :   for(;;)
    2373         301 :   {
    2374        2324 :     GEN r = RgX_neg( Q_primpart(RgX_pseudorem(u, v)) ), sr;
    2375        2324 :     long i, dr = degpol(r);
    2376        2324 :     if (dr < 0) break;
    2377        2324 :     sr = ZV_to_zv(nfeltsign(nf, gel(r,dr+2), ind));
    2378        5579 :     for (i = 1; i < l; i++)
    2379        3255 :       if (sr[i] != s[i]) { s[i] = sr[i], vr1[i]--; }
    2380        2324 :     if (odd(dr)) sr = zv_neg(sr);
    2381        5579 :     for (i = 1; i < l; i++)
    2382        3255 :       if (sr[i] != t[i]) { t[i] = sr[i], vr1[i]++; }
    2383        2324 :     if (!dr) break;
    2384         301 :     u = v; v = r;
    2385             :   }
    2386        2023 :   if (single) return gc_stoi(av,vr1[1]);
    2387        2016 :   return gc_upto(av, zv_to_ZV(vr1));
    2388             : }
    2389             : 
    2390             : /* True nf; return the vector of signs of x; the matrix of such if x is a vector
    2391             :  * of nf elements */
    2392             : GEN
    2393       53914 : nfsign(GEN nf, GEN x)
    2394             : {
    2395             :   long i, l;
    2396             :   GEN archp, S;
    2397             : 
    2398       53914 :   archp = identity_perm( nf_get_r1(nf) );
    2399       53914 :   if (typ(x) != t_VEC) return nfsign_arch(nf, x, archp);
    2400       45507 :   l = lg(x); S = cgetg(l, t_MAT);
    2401      196359 :   for (i=1; i<l; i++) gel(S,i) = nfsign_arch(nf, gel(x,i), archp);
    2402       45507 :   return S;
    2403             : }
    2404             : 
    2405             : /* x integral elt, A integral ideal in HNF; reduce x mod A */
    2406             : static GEN
    2407     8127592 : zk_modHNF(GEN x, GEN A)
    2408     8127592 : { return (typ(x) == t_COL)?  ZC_hnfrem(x, A): modii(x, gcoeff(A,1,1)); }
    2409             : 
    2410             : /* given an element x in Z_K and an integral ideal y in HNF, coprime with x,
    2411             :    outputs an element inverse of x modulo y */
    2412             : GEN
    2413         175 : nfinvmodideal(GEN nf, GEN x, GEN y)
    2414             : {
    2415         175 :   pari_sp av = avma;
    2416         175 :   GEN a, yZ = gcoeff(y,1,1);
    2417             : 
    2418         175 :   if (equali1(yZ)) return gen_0;
    2419         175 :   x = nf_to_scalar_or_basis(nf, x);
    2420         175 :   if (typ(x) == t_INT) return gc_upto(av, Fp_inv(x, yZ));
    2421             : 
    2422          79 :   a = hnfmerge_get_1(idealhnf_principal(nf,x), y);
    2423          79 :   if (!a) pari_err_INV("nfinvmodideal", x);
    2424          79 :   return gc_upto(av, zk_modHNF(nfdiv(nf,a,x), y));
    2425             : }
    2426             : 
    2427             : static GEN
    2428     2812160 : nfsqrmodideal(GEN nf, GEN x, GEN id)
    2429     2812160 : { return zk_modHNF(nfsqri(nf,x), id); }
    2430             : static GEN
    2431     7838523 : nfmulmodideal(GEN nf, GEN x, GEN y, GEN id)
    2432     7838523 : { return x? zk_modHNF(nfmuli(nf,x,y), id): y; }
    2433             : /* assume x integral, k integer, A in HNF */
    2434             : GEN
    2435     6477141 : nfpowmodideal(GEN nf,GEN x,GEN k,GEN A)
    2436             : {
    2437     6477141 :   long s = signe(k);
    2438             :   pari_sp av;
    2439             :   GEN y;
    2440             : 
    2441     6477141 :   if (!s) return gen_1;
    2442     6477141 :   av = avma;
    2443     6477141 :   x = nf_to_scalar_or_basis(nf, x);
    2444     6477366 :   if (typ(x) != t_COL) return Fp_pow(x, k, gcoeff(A,1,1));
    2445     2803643 :   if (s < 0) { k = negi(k); x = nfinvmodideal(nf, x,A); }
    2446     2803643 :   if (equali1(k)) return gc_upto(av, s > 0? zk_modHNF(x, A): x);
    2447     1274009 :   for(y = NULL;;)
    2448             :   {
    2449     4086350 :     if (mpodd(k)) y = nfmulmodideal(nf,y,x,A);
    2450     4086318 :     k = shifti(k,-1); if (!signe(k)) break;
    2451     2811790 :     x = nfsqrmodideal(nf,x,A);
    2452             :   }
    2453     1274019 :   return gc_upto(av, y);
    2454             : }
    2455             : 
    2456             : /* a * g^n mod id */
    2457             : static GEN
    2458     5077225 : nfmulpowmodideal(GEN nf, GEN a, GEN g, GEN n, GEN id)
    2459             : {
    2460     5077225 :   return nfmulmodideal(nf, a, nfpowmodideal(nf,g,n,id), id);
    2461             : }
    2462             : 
    2463             : /* assume (num(g[i]), id) = 1 for all i. Return prod g[i]^e[i] mod id.
    2464             :  * EX = multiple of exponent of (O_K/id)^* */
    2465             : GEN
    2466     2925578 : famat_to_nf_modideal_coprime(GEN nf, GEN g, GEN e, GEN id, GEN EX)
    2467             : {
    2468     2925578 :   GEN EXo2, plus = NULL, minus = NULL, idZ = gcoeff(id,1,1);
    2469     2925578 :   long i, lx = lg(g);
    2470             : 
    2471     2925578 :   if (equali1(idZ)) return gen_1; /* id = Z_K */
    2472     2925133 :   EXo2 = (expi(EX) > 10)? shifti(EX,-1): NULL;
    2473     9178333 :   for (i = 1; i < lx; i++)
    2474             :   {
    2475     6253302 :     GEN h, n = centermodii(gel(e,i), EX, EXo2);
    2476     6252827 :     long sn = signe(n);
    2477     6252827 :     if (!sn) continue;
    2478             : 
    2479     4344677 :     h = nf_to_scalar_or_basis(nf, gel(g,i));
    2480     4345083 :     switch(typ(h))
    2481             :     {
    2482     2641014 :       case t_INT: break;
    2483           0 :       case t_FRAC:
    2484           0 :         h = Fp_div(gel(h,1), gel(h,2), idZ); break;
    2485     1704069 :       default:
    2486             :       {
    2487             :         GEN dh;
    2488     1704069 :         h = Q_remove_denom(h, &dh);
    2489     1704210 :         if (dh) h = FpC_Fp_mul(h, Fp_inv(dh,idZ), idZ);
    2490             :       }
    2491             :     }
    2492     4345125 :     if (sn > 0)
    2493     4343289 :       plus = nfmulpowmodideal(nf, plus, h, n, id);
    2494             :     else /* sn < 0 */
    2495        1836 :       minus = nfmulpowmodideal(nf, minus, h, negi(n), id);
    2496             :   }
    2497     2925031 :   if (minus) plus = nfmulmodideal(nf, plus, nfinvmodideal(nf,minus,id), id);
    2498     2925126 :   return plus? plus: gen_1;
    2499             : }
    2500             : 
    2501             : /* given 2 integral ideals x, y in HNF s.t x | y | x^2, compute (1+x)/(1+y) in
    2502             :  * the form [[cyc],[gen], U], where U := ux^-1 as a pair [ZM, denom(U)] */
    2503             : static GEN
    2504      275324 : zidealij(GEN x, GEN y)
    2505             : {
    2506      275324 :   GEN U, G, cyc, xp = gcoeff(x,1,1), xi = hnf_invscale(x, xp);
    2507             :   long j, N;
    2508             : 
    2509             :   /* x^(-1) y = relations between the 1 + x_i (HNF) */
    2510      275313 :   cyc = ZM_snf_group(ZM_Z_divexact(ZM_mul(xi, y), xp), &U, &G);
    2511      275316 :   N = lg(cyc); G = ZM_mul(x,G); settyp(G, t_VEC); /* new generators */
    2512      652044 :   for (j=1; j<N; j++)
    2513             :   {
    2514      376748 :     GEN c = gel(G,j);
    2515      376748 :     gel(c,1) = addiu(gel(c,1), 1); /* 1 + g_j */
    2516      376732 :     if (ZV_isscalar(c)) gel(G,j) = gel(c,1);
    2517             :   }
    2518      275296 :   return mkvec4(cyc, G, ZM_mul(U,xi), xp);
    2519             : }
    2520             : 
    2521             : /* lg(x) > 1, x + 1; shallow */
    2522             : static GEN
    2523      204722 : ZC_add1(GEN x)
    2524             : {
    2525      204722 :   long i, l = lg(x);
    2526      204722 :   GEN y = cgetg(l, t_COL);
    2527      471421 :   for (i = 2; i < l; i++) gel(y,i) = gel(x,i);
    2528      204719 :   gel(y,1) = addiu(gel(x,1), 1); return y;
    2529             : }
    2530             : /* lg(x) > 1, x - 1; shallow */
    2531             : static GEN
    2532       71776 : ZC_sub1(GEN x)
    2533             : {
    2534       71776 :   long i, l = lg(x);
    2535       71776 :   GEN y = cgetg(l, t_COL);
    2536      182047 :   for (i = 2; i < l; i++) gel(y,i) = gel(x,i);
    2537       71777 :   gel(y,1) = subiu(gel(x,1), 1); return y;
    2538             : }
    2539             : 
    2540             : /* x,y are t_INT or ZC */
    2541             : static GEN
    2542           0 : zkadd(GEN x, GEN y)
    2543             : {
    2544           0 :   long tx = typ(x);
    2545           0 :   if (tx == typ(y))
    2546           0 :     return tx == t_INT? addii(x,y): ZC_add(x,y);
    2547             :   else
    2548           0 :     return tx == t_INT? ZC_Z_add(y,x): ZC_Z_add(x,y);
    2549             : }
    2550             : /* x a t_INT or ZC, x+1; shallow */
    2551             : static GEN
    2552      301798 : zkadd1(GEN x)
    2553             : {
    2554      301798 :   long tx = typ(x);
    2555      301798 :   return tx == t_INT? addiu(x,1): ZC_add1(x);
    2556             : }
    2557             : /* x a t_INT or ZC, x-1; shallow */
    2558             : static GEN
    2559      301841 : zksub1(GEN x)
    2560             : {
    2561      301841 :   long tx = typ(x);
    2562      301841 :   return tx == t_INT? subiu(x,1): ZC_sub1(x);
    2563             : }
    2564             : /* x,y are t_INT or ZC; x - y */
    2565             : static GEN
    2566           0 : zksub(GEN x, GEN y)
    2567             : {
    2568           0 :   long tx = typ(x), ty = typ(y);
    2569           0 :   if (tx == ty)
    2570           0 :     return tx == t_INT? subii(x,y): ZC_sub(x,y);
    2571             :   else
    2572           0 :     return tx == t_INT? Z_ZC_sub(x,y): ZC_Z_sub(x,y);
    2573             : }
    2574             : /* x is t_INT or ZM (mult. map), y is t_INT or ZC; x * y */
    2575             : static GEN
    2576      301805 : zkmul(GEN x, GEN y)
    2577             : {
    2578      301805 :   long tx = typ(x), ty = typ(y);
    2579      301805 :   if (ty == t_INT)
    2580      230052 :     return tx == t_INT? mulii(x,y): ZC_Z_mul(gel(x,1),y);
    2581             :   else
    2582       71753 :     return tx == t_INT? ZC_Z_mul(y,x): ZM_ZC_mul(x,y);
    2583             : }
    2584             : 
    2585             : /* (U,V) = 1 coprime ideals. Want z = x mod U, = y mod V; namely
    2586             :  * z =vx + uy = v(x-y) + y, where u + v = 1, u in U, v in V.
    2587             :  * zkc = [v, UV], v a t_INT or ZM (mult. by v map), UV a ZM (ideal in HNF);
    2588             :  * shallow */
    2589             : GEN
    2590           0 : zkchinese(GEN zkc, GEN x, GEN y)
    2591             : {
    2592           0 :   GEN v = gel(zkc,1), UV = gel(zkc,2), z = zkadd(zkmul(v, zksub(x,y)), y);
    2593           0 :   return zk_modHNF(z, UV);
    2594             : }
    2595             : /* special case z = x mod U, = 1 mod V; shallow */
    2596             : GEN
    2597      301840 : zkchinese1(GEN zkc, GEN x)
    2598             : {
    2599      301840 :   GEN v = gel(zkc,1), UV = gel(zkc,2), z = zkadd1(zkmul(v, zksub1(x)));
    2600      301817 :   return (typ(z) == t_INT)? z: ZC_hnfrem(z, UV);
    2601             : }
    2602             : static GEN
    2603      270565 : zkVchinese1(GEN zkc, GEN v)
    2604             : {
    2605             :   long i, ly;
    2606      270565 :   GEN y = cgetg_copy(v, &ly);
    2607      572380 :   for (i=1; i<ly; i++) gel(y,i) = zkchinese1(zkc, gel(v,i));
    2608      270538 :   return y;
    2609             : }
    2610             : 
    2611             : /* prepare to solve z = x (mod A), z = y mod (B) [zkchinese or zkchinese1] */
    2612             : GEN
    2613      270320 : zkchineseinit(GEN nf, GEN A, GEN B, GEN AB)
    2614             : {
    2615      270320 :   GEN v = idealaddtoone_raw(nf, A, B);
    2616             :   long e;
    2617      270296 :   if ((e = gexpo(v)) > 5)
    2618             :   {
    2619       83350 :     GEN b = (typ(v) == t_COL)? v: scalarcol_shallow(v, nf_get_degree(nf));
    2620       83350 :     b= ZC_reducemodlll(b, AB);
    2621       83355 :     if (gexpo(b) < e) v = b;
    2622             :   }
    2623      270300 :   return mkvec2(zk_scalar_or_multable(nf,v), AB);
    2624             : }
    2625             : /* prepare to solve z = x (mod A), z = 1 mod (B)
    2626             :  * and then         z = 1 (mod A), z = y mod (B) [zkchinese1 twice] */
    2627             : static GEN
    2628         259 : zkchinese1init2(GEN nf, GEN A, GEN B, GEN AB)
    2629             : {
    2630         259 :   GEN zkc = zkchineseinit(nf, A, B, AB);
    2631         259 :   GEN mv = gel(zkc,1), mu;
    2632         259 :   if (typ(mv) == t_INT) return mkvec2(zkc, mkvec2(subui(1,mv),AB));
    2633          35 :   mu = RgM_Rg_add_shallow(ZM_neg(mv), gen_1);
    2634          35 :   return mkvec2(mkvec2(mv,AB), mkvec2(mu,AB));
    2635             : }
    2636             : 
    2637             : static GEN
    2638     2777357 : apply_U(GEN L, GEN a)
    2639             : {
    2640     2777357 :   GEN e, U = gel(L,3), dU = gel(L,4);
    2641     2777357 :   if (typ(a) == t_INT)
    2642      971469 :     e = ZC_Z_mul(gel(U,1), subiu(a, 1));
    2643             :   else
    2644             :   { /* t_COL */
    2645     1805888 :     GEN t = shallowcopy(a);
    2646     1805956 :     gel(t,1) = subiu(gel(t,1), 1); /* t = a - 1 */
    2647     1805871 :     e = ZM_ZC_mul(U, t);
    2648             :   }
    2649     2777299 :   return gdiv(e, dU);
    2650             : }
    2651             : 
    2652             : /* true nf; vectors of [[cyc],[g],U.X^-1]. Assume k > 1. */
    2653             : static GEN
    2654      194093 : principal_units(GEN nf, GEN pr, long k, GEN prk)
    2655             : {
    2656             :   GEN list, prb;
    2657      194093 :   ulong mask = quadratic_prec_mask(k);
    2658      194093 :   long a = 1;
    2659             : 
    2660      194093 :   prb = pr_hnf(nf,pr);
    2661      194099 :   list = vectrunc_init(k);
    2662      469423 :   while (mask > 1)
    2663             :   {
    2664      275325 :     GEN pra = prb;
    2665      275325 :     long b = a << 1;
    2666             : 
    2667      275325 :     if (mask & 1) b--;
    2668      275325 :     mask >>= 1;
    2669             :     /* compute 1 + pr^a / 1 + pr^b, 2a <= b */
    2670      275325 :     prb = (b >= k)? prk: idealpows(nf,pr,b);
    2671      275326 :     vectrunc_append(list, zidealij(pra, prb));
    2672      275327 :     a = b;
    2673             :   }
    2674      194098 :   return list;
    2675             : }
    2676             : /* a = 1 mod (pr) return log(a) on local-gens of 1+pr/1+pr^k */
    2677             : static GEN
    2678     1683864 : log_prk1(GEN nf, GEN a, long nh, GEN L2, GEN prk)
    2679             : {
    2680     1683864 :   GEN y = cgetg(nh+1, t_COL);
    2681     1683883 :   long j, iy, c = lg(L2)-1;
    2682     4461200 :   for (j = iy = 1; j <= c; j++)
    2683             :   {
    2684     2777348 :     GEN L = gel(L2,j), cyc = gel(L,1), gen = gel(L,2), E = apply_U(L,a);
    2685     2777202 :     long i, nc = lg(cyc)-1;
    2686     2777202 :     int last = (j == c);
    2687     7102606 :     for (i = 1; i <= nc; i++, iy++)
    2688             :     {
    2689     4325289 :       GEN t, e = gel(E,i);
    2690     4325289 :       if (typ(e) != t_INT) pari_err_COPRIME("zlog_prk1", a, prk);
    2691     4325282 :       t = Fp_neg(e, gel(cyc,i));
    2692     4325329 :       gel(y,iy) = negi(t);
    2693     4325388 :       if (!last && signe(t)) a = nfmulpowmodideal(nf, a, gel(gen,i), t, prk);
    2694             :     }
    2695             :   }
    2696     1683852 :   return y;
    2697             : }
    2698             : /* true nf */
    2699             : static GEN
    2700       69958 : principal_units_relations(GEN nf, GEN L2, GEN prk, long nh)
    2701             : {
    2702       69958 :   GEN h = cgetg(nh+1,t_MAT);
    2703       69958 :   long ih, j, c = lg(L2)-1;
    2704      221142 :   for (j = ih = 1; j <= c; j++)
    2705             :   {
    2706      151186 :     GEN L = gel(L2,j), F = gel(L,1), G = gel(L,2);
    2707      151186 :     long k, lG = lg(G);
    2708      358908 :     for (k = 1; k < lG; k++,ih++)
    2709             :     { /* log(g^f) mod pr^e */
    2710      207724 :       GEN a = nfpowmodideal(nf,gel(G,k),gel(F,k),prk);
    2711      207723 :       gel(h,ih) = ZC_neg(log_prk1(nf, a, nh, L2, prk));
    2712      207722 :       gcoeff(h,ih,ih) = gel(F,k);
    2713             :     }
    2714             :   }
    2715       69956 :   return h;
    2716             : }
    2717             : /* true nf; k > 1; multiplicative group (1 + pr) / (1 + pr^k) */
    2718             : static GEN
    2719      194097 : idealprincipalunits_i(GEN nf, GEN pr, long k, GEN *pU)
    2720             : {
    2721      194097 :   GEN cyc, gen, L2, prk = idealpows(nf, pr, k);
    2722             : 
    2723      194093 :   L2 = principal_units(nf, pr, k, prk);
    2724      194100 :   if (k == 2)
    2725             :   {
    2726      124143 :     GEN L = gel(L2,1);
    2727      124143 :     cyc = gel(L,1);
    2728      124143 :     gen = gel(L,2);
    2729      124143 :     if (pU) *pU = matid(lg(gen)-1);
    2730             :   }
    2731             :   else
    2732             :   {
    2733       69957 :     long c = lg(L2), j;
    2734       69957 :     GEN EX, h, Ui, vg = cgetg(c, t_VEC);
    2735      221141 :     for (j = 1; j < c; j++) gel(vg, j) = gmael(L2,j,2);
    2736       69957 :     vg = shallowconcat1(vg);
    2737       69958 :     h = principal_units_relations(nf, L2, prk, lg(vg)-1);
    2738       69957 :     h = ZM_hnfall_i(h, NULL, 0);
    2739       69958 :     cyc = ZM_snf_group(h, pU, &Ui);
    2740       69958 :     c = lg(Ui); gen = cgetg(c, t_VEC); EX = cyc_get_expo(cyc);
    2741      228828 :     for (j = 1; j < c; j++)
    2742      158870 :       gel(gen,j) = famat_to_nf_modideal_coprime(nf, vg, gel(Ui,j), prk, EX);
    2743             :   }
    2744      194101 :   return mkvec4(cyc, gen, prk, L2);
    2745             : }
    2746             : GEN
    2747         196 : idealprincipalunits(GEN nf, GEN pr, long k)
    2748             : {
    2749             :   pari_sp av;
    2750             :   GEN v;
    2751         196 :   nf = checknf(nf);
    2752         196 :   if (k == 1) { checkprid(pr); retmkvec3(gen_1,cgetg(1,t_VEC),cgetg(1,t_VEC)); }
    2753         189 :   av = avma; v = idealprincipalunits_i(nf, pr, k, NULL);
    2754         189 :   return gc_GEN(av, mkvec3(powiu(pr_norm(pr), k-1), gel(v,1), gel(v,2)));
    2755             : }
    2756             : 
    2757             : /* true nf; given an ideal pr^k dividing an integral ideal x (in HNF form)
    2758             :  * compute an 'sprk', the structure of G = (Z_K/pr^k)^* [ x = NULL for x=pr^k ]
    2759             :  * Return a vector with at least 4 components [cyc],[gen],[HNF pr^k,pr,k],ff,
    2760             :  * where
    2761             :  * cyc : type of G as abelian group (SNF)
    2762             :  * gen : generators of G, coprime to x
    2763             :  * pr^k: in HNF
    2764             :  * ff  : data for log_g in (Z_K/pr)^*
    2765             :  * Two extra components are present iff k > 1: L2, U
    2766             :  * L2  : list of data structures to compute local DL in (Z_K/pr)^*,
    2767             :  *       and 1 + pr^a/ 1 + pr^b for various a < b <= min(2a, k)
    2768             :  * U   : base change matrices to convert a vector of local DL to DL wrt gen
    2769             :  * If MOD is not NULL, initialize G / G^MOD instead */
    2770             : static GEN
    2771      465690 : sprkinit(GEN nf, GEN pr, long k, GEN x, GEN MOD)
    2772             : {
    2773      465690 :   GEN T, p, Ld, modpr, cyc, gen, g, g0, A, prk, U, L2, ord0 = NULL;
    2774      465690 :   long f = pr_get_f(pr);
    2775             : 
    2776      465688 :   if(DEBUGLEVEL>3) err_printf("treating pr^%ld, pr = %Ps\n",k,pr);
    2777      465688 :   modpr = nf_to_Fq_init(nf, &pr,&T,&p);
    2778      465706 :   if (MOD)
    2779             :   {
    2780      418022 :     GEN o = subiu(powiu(p,f), 1), d = gcdii(o, MOD), fa = Z_factor(d);
    2781      418004 :     ord0 = mkvec2(o, fa); /* true order, factorization of order in G/G^MOD */
    2782      417995 :     Ld = gel(fa,1);
    2783      417995 :     if (lg(Ld) > 1 && equaliu(gel(Ld,1),2)) Ld = vecslice(Ld,2,lg(Ld)-1);
    2784             :   }
    2785             :   /* (Z_K / pr)^* */
    2786      465687 :   if (f == 1)
    2787             :   {
    2788      375738 :     g0 = g = MOD? pgener_Fp_local(p, Ld): pgener_Fp(p);
    2789      375754 :     if (!ord0) ord0 = get_arith_ZZM(subiu(p,1));
    2790             :   }
    2791             :   else
    2792             :   {
    2793       89949 :     g0 = g = MOD? gener_FpXQ_local(T, p, Ld): gener_FpXQ(T,p, &ord0);
    2794       89949 :     g = Fq_to_nf(g, modpr);
    2795       89949 :     if (typ(g) == t_POL) g = poltobasis(nf, g);
    2796             :   }
    2797      465721 :   A = gel(ord0, 1); /* Norm(pr)-1 */
    2798             :   /* If MOD != NULL, d = gcd(A, MOD): g^(A/d) has order d */
    2799      465721 :   if (k == 1)
    2800             :   {
    2801      271813 :     cyc = mkvec(A);
    2802      271808 :     gen = mkvec(g);
    2803      271804 :     prk = pr_hnf(nf,pr);
    2804      271812 :     L2 = U = NULL;
    2805             :   }
    2806             :   else
    2807             :   { /* local-gens of (1 + pr)/(1 + pr^k) = SNF-gens * U */
    2808             :     GEN AB, B, u, v, w;
    2809             :     long j, l;
    2810      193908 :     w = idealprincipalunits_i(nf, pr, k, &U);
    2811             :     /* incorporate (Z_K/pr)^*, order A coprime to B = expo(1+pr/1+pr^k)*/
    2812      193911 :     cyc = leafcopy(gel(w,1)); B = cyc_get_expo(cyc); AB = mulii(A,B);
    2813      193892 :     gen = leafcopy(gel(w,2));
    2814      193891 :     prk = gel(w,3);
    2815      193891 :     g = nfpowmodideal(nf, g, B, prk);
    2816      193906 :     g0 = Fq_pow(g0, modii(B,A), T, p); /* update primitive root */
    2817      193906 :     L2 = mkvec3(A, g, gel(w,4));
    2818      193906 :     gel(cyc,1) = AB;
    2819      193906 :     gel(gen,1) = nfmulmodideal(nf, gel(gen,1), g, prk);
    2820      193895 :     u = mulii(Fp_inv(A,B), A);
    2821      193899 :     v = subui(1, u); l = lg(U);
    2822      570059 :     for (j = 1; j < l; j++) gcoeff(U,1,j) = Fp_mul(u, gcoeff(U,1,j), AB);
    2823      193901 :     U = mkvec2(Rg_col_ei(v, lg(gen)-1, 1), U);
    2824             :   }
    2825             :   /* local-gens of (Z_K/pr^k)^* = SNF-gens * U */
    2826      465721 :   if (x)
    2827             :   {
    2828      270062 :     GEN uv = zkchineseinit(nf, idealmulpowprime(nf,x,pr,utoineg(k)), prk, x);
    2829      270047 :     gen = zkVchinese1(uv, gen);
    2830             :   }
    2831      465675 :   return mkvecn(U? 6: 4, cyc, gen, prk, mkvec3(modpr,g0,ord0), L2, U);
    2832             : }
    2833             : GEN
    2834     4566426 : sprk_get_cyc(GEN s) { return gel(s,1); }
    2835             : GEN
    2836     2141540 : sprk_get_expo(GEN s) { return cyc_get_expo(sprk_get_cyc(s)); }
    2837             : GEN
    2838      370350 : sprk_get_gen(GEN s) { return gel(s,2); }
    2839             : GEN
    2840     5626037 : sprk_get_prk(GEN s) { return gel(s,3); }
    2841             : GEN
    2842     3039618 : sprk_get_ff(GEN s) { return gel(s,4); }
    2843             : GEN
    2844     2815849 : sprk_get_pr(GEN s) { GEN ff = gel(s,4); return modpr_get_pr(gel(ff,1)); }
    2845             : /* L2 to 1 + pr / 1 + pr^k */
    2846             : static GEN
    2847     1549968 : sprk_get_L2(GEN s) { return gmael(s,5,3); }
    2848             : /* lift to nf of primitive root of k(pr) */
    2849             : static GEN
    2850      318207 : sprk_get_gnf(GEN s) { return gmael(s,5,2); }
    2851             : /* A = Npr-1, <g> = (Z_K/pr)^*, L2 to 1 + pr / 1 + pr^k */
    2852             : void
    2853           0 : sprk_get_AgL2(GEN s, GEN *A, GEN *g, GEN *L2)
    2854           0 : { GEN v = gel(s,5); *A = gel(v,1); *g = gel(v,2); *L2 = gel(v,3); }
    2855             : void
    2856     1529860 : sprk_get_U2(GEN s, GEN *U1, GEN *U2)
    2857     1529860 : { GEN v = gel(s,6); *U1 = gel(v,1); *U2 = gel(v,2); }
    2858             : static int
    2859     3039607 : sprk_is_prime(GEN s) { return lg(s) == 5; }
    2860             : 
    2861             : GEN
    2862     2141345 : famat_zlog_pr(GEN nf, GEN g, GEN e, GEN sprk, GEN mod)
    2863             : {
    2864     2141345 :   GEN x, expo = sprk_get_expo(sprk);
    2865     2141345 :   if (mod) expo = gcdii(expo,mod);
    2866     2141336 :   x = famat_makecoprime(nf, g, e, sprk_get_pr(sprk), sprk_get_prk(sprk), expo);
    2867     2141348 :   return log_prk(nf, x, sprk, mod);
    2868             : }
    2869             : /* famat_zlog_pr assuming (g,sprk.pr) = 1 */
    2870             : static GEN
    2871         196 : famat_zlog_pr_coprime(GEN nf, GEN g, GEN e, GEN sprk, GEN MOD)
    2872             : {
    2873         196 :   GEN x = famat_to_nf_modideal_coprime(nf, g, e, sprk_get_prk(sprk),
    2874             :                                        sprk_get_expo(sprk));
    2875         196 :   return log_prk(nf, x, sprk, MOD);
    2876             : }
    2877             : 
    2878             : /* o t_INT, O = [ord,fa] format for multiple of o (for Fq_log);
    2879             :  * return o in [ord,fa] format */
    2880             : static GEN
    2881      739846 : order_update(GEN o, GEN O)
    2882             : {
    2883      739846 :   GEN p = gmael(O,2,1), z = o, P, E;
    2884      739846 :   long i, j, l = lg(p);
    2885      739846 :   P = cgetg(l, t_COL);
    2886      739842 :   E = cgetg(l, t_COL);
    2887      797042 :   for (i = j = 1; i < l; i++)
    2888             :   {
    2889      797042 :     long v = Z_pvalrem(z, gel(p,i), &z);
    2890      796986 :     if (v)
    2891             :     {
    2892      783893 :       gel(P,j) = gel(p,i);
    2893      783893 :       gel(E,j) = utoipos(v); j++;
    2894      783911 :       if (is_pm1(z)) break;
    2895             :     }
    2896             :   }
    2897      739803 :   setlg(P, j);
    2898      739804 :   setlg(E, j); return mkvec2(o, mkmat2(P,E));
    2899             : }
    2900             : 
    2901             : /* a in Z_K (t_COL or t_INT), pr prime ideal, sprk = sprkinit(nf,pr,k,x),
    2902             :  * mod positive t_INT or NULL (meaning mod=0).
    2903             :  * return log(a) modulo mod on SNF-generators of (Z_K/pr^k)^* */
    2904             : GEN
    2905     3122208 : log_prk(GEN nf, GEN a, GEN sprk, GEN mod)
    2906             : {
    2907             :   GEN e, prk, g, U1, U2, y, ff, O, o, oN, gN,  N, T, p, modpr, pr, cyc;
    2908             : 
    2909     3122208 :   if (typ(a) == t_MAT) return famat_zlog_pr(nf, gel(a,1), gel(a,2), sprk, mod);
    2910     3039603 :   N = NULL;
    2911     3039603 :   ff = sprk_get_ff(sprk);
    2912     3039611 :   pr = gel(ff,1); /* modpr */
    2913     3039611 :   g = gN = gel(ff,2);
    2914     3039611 :   O = gel(ff,3); /* order of g = |Fq^*|, in [ord, fa] format */
    2915     3039611 :   o = oN = gel(O,1); /* order as a t_INT */
    2916     3039611 :   prk = sprk_get_prk(sprk);
    2917     3039627 :   modpr = nf_to_Fq_init(nf, &pr, &T, &p);
    2918     3039624 :   if (mod)
    2919             :   {
    2920     2523115 :     GEN d = gcdii(o,mod);
    2921     2522894 :     if (!equalii(o, d))
    2922             :     {
    2923      947460 :       N = diviiexact(o,d); /* > 1, coprime to p */
    2924      947400 :       a = nfpowmodideal(nf, a, N, prk);
    2925      947561 :       oN = d; /* order of g^N mod pr */
    2926             :     }
    2927             :   }
    2928     3039454 :   if (equali1(oN))
    2929      682553 :     e = gen_0;
    2930             :   else
    2931             :   {
    2932     2356974 :     if (N) { O = order_update(oN, O); gN = Fq_pow(g, N, T, p); }
    2933     2356981 :     e = Fq_log(nf_to_Fq(nf,a,modpr), gN, O, T, p);
    2934             :   }
    2935             :   /* 0 <= e < oN is correct modulo oN */
    2936     3039636 :   if (sprk_is_prime(sprk)) return mkcol(e); /* k = 1 */
    2937             : 
    2938     1084973 :   sprk_get_U2(sprk, &U1,&U2);
    2939     1085071 :   cyc = sprk_get_cyc(sprk);
    2940     1085079 :   if (mod)
    2941             :   {
    2942      663693 :     cyc = ZV_snf_gcd(cyc, mod);
    2943      663660 :     if (signe(remii(mod,p))) return ZV_ZV_mod(ZC_Z_mul(U1,e), cyc);
    2944             :   }
    2945     1031335 :   if (signe(e))
    2946             :   {
    2947      318207 :     GEN E = N? mulii(e, N): e;
    2948      318207 :     a = nfmulpowmodideal(nf, a, sprk_get_gnf(sprk), Fp_neg(E, o), prk);
    2949             :   }
    2950             :   /* a = 1 mod pr */
    2951     1031335 :   y = log_prk1(nf, a, lg(U2)-1, sprk_get_L2(sprk), prk);
    2952     1031375 :   if (N)
    2953             :   { /* from DL(a^N) to DL(a) */
    2954      152177 :     GEN E = gel(sprk_get_cyc(sprk), 1), q = powiu(p, Z_pval(E, p));
    2955      152177 :     y = ZC_Z_mul(y, Fp_inv(N, q));
    2956             :   }
    2957     1031376 :   y = ZC_lincomb(gen_1, e, ZM_ZC_mul(U2,y), U1);
    2958     1031372 :   return ZV_ZV_mod(y, cyc);
    2959             : }
    2960             : /* true nf */
    2961             : GEN
    2962       95416 : log_prk_init(GEN nf, GEN pr, long k, GEN MOD)
    2963       95416 : { return sprkinit(nf,pr,k,NULL,MOD);}
    2964             : GEN
    2965         497 : veclog_prk(GEN nf, GEN v, GEN sprk)
    2966             : {
    2967         497 :   long l = lg(v), i;
    2968         497 :   GEN w = cgetg(l, t_MAT);
    2969        1232 :   for (i = 1; i < l; i++) gel(w,i) = log_prk(nf, gel(v,i), sprk, NULL);
    2970         497 :   return w;
    2971             : }
    2972             : 
    2973             : static GEN
    2974     1424661 : famat_zlog(GEN nf, GEN fa, GEN sgn, zlog_S *S)
    2975             : {
    2976     1424661 :   long i, l0, l = lg(S->U);
    2977     1424661 :   GEN g = gel(fa,1), e = gel(fa,2), y = cgetg(l, t_COL);
    2978     1424662 :   l0 = lg(S->sprk); /* = l (trivial arch. part), or l-1 */
    2979     3065925 :   for (i=1; i < l0; i++) gel(y,i) = famat_zlog_pr(nf, g, e, gel(S->sprk,i), S->mod);
    2980     1424665 :   if (l0 != l)
    2981             :   {
    2982      233420 :     if (!sgn) sgn = nfsign_arch(nf, fa, S->archp);
    2983      233420 :     gel(y,l0) = Flc_to_ZC(sgn);
    2984             :   }
    2985     1424665 :   return y;
    2986             : }
    2987             : 
    2988             : /* assume that cyclic factors are normalized, in particular != [1] */
    2989             : static GEN
    2990      270380 : split_U(GEN U, GEN Sprk)
    2991             : {
    2992      270380 :   long t = 0, k, n, l = lg(Sprk);
    2993      270380 :   GEN vU = cgetg(l+1, t_VEC);
    2994      639963 :   for (k = 1; k < l; k++)
    2995             :   {
    2996      369585 :     n = lg(sprk_get_cyc(gel(Sprk,k))) - 1; /* > 0 */
    2997      369586 :     gel(vU,k) = vecslice(U, t+1, t+n);
    2998      369588 :     t += n;
    2999             :   }
    3000             :   /* t+1 .. lg(U)-1 */
    3001      270378 :   n = lg(U) - t - 1; /* can be 0 */
    3002      270378 :   if (!n) setlg(vU,l); else gel(vU,l) = vecslice(U, t+1, t+n);
    3003      270378 :   return vU;
    3004             : }
    3005             : 
    3006             : static void
    3007     2157263 : init_zlog_mod(zlog_S *S, GEN bid, GEN mod)
    3008             : {
    3009     2157263 :   GEN fa2 = bid_get_fact2(bid), MOD = bid_get_MOD(bid);
    3010     2157255 :   S->U = bid_get_U(bid);
    3011     2157259 :   S->hU = lg(bid_get_cyc(bid))-1;
    3012     2157257 :   S->archp = bid_get_archp(bid);
    3013     2157256 :   S->sprk = bid_get_sprk(bid);
    3014     2157256 :   S->bid = bid;
    3015     2157256 :   if (MOD) mod = mod? gcdii(mod, MOD): MOD;
    3016     2157160 :   S->mod = mod;
    3017     2157160 :   S->P = gel(fa2,1);
    3018     2157160 :   S->k = gel(fa2,2);
    3019     2157160 :   S->no2 = lg(S->P) == lg(gel(bid_get_fact(bid),1));
    3020     2157182 : }
    3021             : void
    3022      395962 : init_zlog(zlog_S *S, GEN bid)
    3023             : {
    3024      395962 :   return init_zlog_mod(S, bid, NULL);
    3025             : }
    3026             : 
    3027             : /* a a t_FRAC/t_INT, reduce mod bid */
    3028             : static GEN
    3029          14 : Q_mod_bid(GEN bid, GEN a)
    3030             : {
    3031          14 :   GEN xZ = gcoeff(bid_get_ideal(bid),1,1);
    3032          14 :   GEN b = Rg_to_Fp(a, xZ);
    3033          14 :   if (gsigne(a) < 0) b = subii(b, xZ);
    3034          14 :   return signe(b)? b: xZ;
    3035             : }
    3036             : /* Return decomposition of a on the CRT generators blocks attached to the
    3037             :  * S->sprk and sarch; sgn = sign(a, S->arch), NULL if unknown */
    3038             : static GEN
    3039      495229 : zlog(GEN nf, GEN a, GEN sgn, zlog_S *S)
    3040             : {
    3041             :   long k, l;
    3042             :   GEN y;
    3043      495229 :   a = nf_to_scalar_or_basis(nf, a);
    3044      495199 :   switch(typ(a))
    3045             :   {
    3046      184968 :     case t_INT: break;
    3047          14 :     case t_FRAC: a = Q_mod_bid(S->bid, a); break;
    3048      310217 :     default: /* case t_COL: */
    3049             :     {
    3050             :       GEN den;
    3051      310217 :       a = Q_remove_denom(a, &den);
    3052      310249 :       if (den)
    3053             :       {
    3054          84 :         a = mkmat2(mkcol2(a, den), mkcol2(gen_1, gen_m1));
    3055          84 :         return famat_zlog(nf, a, sgn, S);
    3056             :       }
    3057             :     }
    3058             :   }
    3059      495138 :   if (sgn)
    3060      400806 :     sgn = (lg(sgn) == 1)? NULL: leafcopy(sgn);
    3061             :   else
    3062       94332 :     sgn = (lg(S->archp) == 1)? NULL: nfsign_arch(nf, a, S->archp);
    3063      495138 :   l = lg(S->sprk);
    3064      495138 :   y = cgetg(sgn? l+1: l, t_COL);
    3065     1350412 :   for (k = 1; k < l; k++)
    3066             :   {
    3067      855301 :     GEN sprk = gel(S->sprk,k);
    3068      855301 :     gel(y,k) = log_prk(nf, a, sprk, S->mod);
    3069             :   }
    3070      495111 :   if (sgn) gel(y,l) = Flc_to_ZC(sgn);
    3071      495115 :   return y;
    3072             : }
    3073             : 
    3074             : /* true nf */
    3075             : GEN
    3076       72240 : pr_basis_perm(GEN nf, GEN pr)
    3077             : {
    3078       72240 :   long f = pr_get_f(pr);
    3079             :   GEN perm;
    3080       72240 :   if (f == nf_get_degree(nf)) return identity_perm(f);
    3081       62160 :   perm = cgetg(f+1, t_VECSMALL);
    3082       62160 :   perm[1] = 1;
    3083       62160 :   if (f > 1)
    3084             :   {
    3085        3248 :     GEN H = pr_hnf(nf,pr);
    3086             :     long i, k;
    3087       11480 :     for (i = k = 2; k <= f; i++)
    3088        8232 :       if (!equali1(gcoeff(H,i,i))) perm[k++] = i;
    3089             :   }
    3090       62160 :   return perm;
    3091             : }
    3092             : 
    3093             : /* \sum U[i]*y[i], U[i] ZM, y[i] ZC. We allow lg(y) > lg(U). */
    3094             : static GEN
    3095     1919869 : ZMV_ZCV_mul(GEN U, GEN y)
    3096             : {
    3097     1919869 :   long i, l = lg(U);
    3098     1919869 :   GEN z = NULL;
    3099     1919869 :   if (l == 1) return cgetg(1,t_COL);
    3100     4915477 :   for (i = 1; i < l; i++)
    3101             :   {
    3102     2995707 :     GEN u = ZM_ZC_mul(gel(U,i), gel(y,i));
    3103     2995634 :     z = z? ZC_add(z, u): u;
    3104             :   }
    3105     1919770 :   return z;
    3106             : }
    3107             : /* A * (x[1], ..., x[d] */
    3108             : static GEN
    3109         518 : ZM_ZMV_mul(GEN A, GEN x)
    3110        1057 : { pari_APPLY_same(ZM_mul(A,gel(x,i))); }
    3111             : 
    3112             : /* a = 1 mod pr, sprk mod pr^e, e >= 1 */
    3113             : static GEN
    3114      444812 : sprk_log_prk1_2(GEN nf, GEN a, GEN sprk)
    3115             : {
    3116      444812 :   GEN U1, U2, y, L2 = sprk_get_L2(sprk);
    3117      444811 :   sprk_get_U2(sprk, &U1,&U2);
    3118      444812 :   y = ZM_ZC_mul(U2, log_prk1(nf, a, lg(U2)-1, L2, sprk_get_prk(sprk)));
    3119      444797 :   return ZV_ZV_mod(y, sprk_get_cyc(sprk));
    3120             : }
    3121             : /* true nf; assume e >= 2 */
    3122             : GEN
    3123      145820 : sprk_log_gen_pr2(GEN nf, GEN sprk, long e)
    3124             : {
    3125      145820 :   GEN M, G, pr = sprk_get_pr(sprk);
    3126             :   long i, l;
    3127      145820 :   if (e == 2)
    3128             :   {
    3129       73835 :     GEN L2 = sprk_get_L2(sprk), L = gel(L2,1);
    3130       73835 :     G = gel(L,2); l = lg(G);
    3131             :   }
    3132             :   else
    3133             :   {
    3134       71985 :     GEN perm = pr_basis_perm(nf,pr), PI = nfpow_u(nf, pr_get_gen(pr), e-1);
    3135       71988 :     l = lg(perm);
    3136       71988 :     G = cgetg(l, t_VEC);
    3137       71988 :     if (typ(PI) == t_INT)
    3138             :     { /* zk_ei_mul doesn't allow t_INT */
    3139       10073 :       long N = nf_get_degree(nf);
    3140       10073 :       gel(G,1) = addiu(PI,1);
    3141       13076 :       for (i = 2; i < l; i++)
    3142             :       {
    3143        3003 :         GEN z = col_ei(N, 1);
    3144        3003 :         gel(G,i) = z; gel(z, perm[i]) = PI;
    3145             :       }
    3146             :     }
    3147             :     else
    3148             :     {
    3149       61915 :       gel(G,1) = nfadd(nf, gen_1, PI);
    3150       69034 :       for (i = 2; i < l; i++)
    3151        7119 :         gel(G,i) = nfadd(nf, gen_1, zk_ei_mul(nf, PI, perm[i]));
    3152             :     }
    3153             :   }
    3154      145823 :   M = cgetg(l, t_MAT);
    3155      314766 :   for (i = 1; i < l; i++) gel(M,i) = sprk_log_prk1_2(nf, gel(G,i), sprk);
    3156      145809 :   return M;
    3157             : }
    3158             : /* Log on bid.gen of generators of P_{1,I pr^{e-1}} / P_{1,I pr^e} (I,pr) = 1,
    3159             :  * defined implicitly via CRT. 'ind' is the index of pr in modulus
    3160             :  * factorization; true nf */
    3161             : GEN
    3162      484266 : log_gen_pr(zlog_S *S, long ind, GEN nf, long e)
    3163             : {
    3164      484266 :   GEN Uind = gel(S->U, ind);
    3165      484266 :   if (e == 1) retmkmat( gel(Uind,1) );
    3166      143124 :   return ZM_mul(Uind, sprk_log_gen_pr2(nf, gel(S->sprk,ind), e));
    3167             : }
    3168             : /* true nf */
    3169             : GEN
    3170        2037 : sprk_log_gen_pr(GEN nf, GEN sprk, long e)
    3171             : {
    3172        2037 :   if (e == 1)
    3173             :   {
    3174           0 :     long n = lg(sprk_get_cyc(sprk))-1;
    3175           0 :     retmkmat(col_ei(n, 1));
    3176             :   }
    3177        2037 :   return sprk_log_gen_pr2(nf, sprk, e);
    3178             : }
    3179             : /* a = 1 mod pr */
    3180             : GEN
    3181      275855 : sprk_log_prk1(GEN nf, GEN a, GEN sprk)
    3182             : {
    3183      275855 :   if (lg(sprk) == 5) return mkcol(gen_0); /* mod pr */
    3184      275855 :   return sprk_log_prk1_2(nf, a, sprk);
    3185             : }
    3186             : /* Log on bid.gen of generator of P_{1,f} / P_{1,f v[index]}
    3187             :  * v = vector of r1 real places */
    3188             : GEN
    3189      111987 : log_gen_arch(zlog_S *S, long index) { return gel(veclast(S->U), index); }
    3190             : 
    3191             : /* compute bid.clgp: [h,cyc] or [h,cyc,gen] */
    3192             : static GEN
    3193      271390 : bid_grp(GEN nf, GEN U, GEN cyc, GEN g, GEN F, GEN sarch)
    3194             : {
    3195      271390 :   GEN G, h = ZV_prod(cyc);
    3196             :   long c;
    3197      271411 :   if (!U) return mkvec2(h,cyc);
    3198      271054 :   c = lg(U);
    3199      271054 :   G = cgetg(c,t_VEC);
    3200      271068 :   if (c > 1)
    3201             :   {
    3202      240975 :     GEN U0, Uoo, EX = cyc_get_expo(cyc); /* exponent of bid */
    3203      240974 :     long i, hU = nbrows(U), nba = lg(sarch_get_cyc(sarch))-1; /* #f_oo */
    3204      240988 :     if (!nba) { U0 = U; Uoo = NULL; }
    3205       90582 :     else if (nba == hU) { U0 = NULL; Uoo = U; }
    3206             :     else
    3207             :     {
    3208       81440 :       U0 = rowslice(U, 1, hU-nba);
    3209       81441 :       Uoo = rowslice(U, hU-nba+1, hU);
    3210             :     }
    3211      771488 :     for (i = 1; i < c; i++)
    3212             :     {
    3213      530516 :       GEN t = gen_1;
    3214      530516 :       if (U0) t = famat_to_nf_modideal_coprime(nf, g, gel(U0,i), F, EX);
    3215      530507 :       if (Uoo) t = set_sign_mod_divisor(nf, ZV_to_Flv(gel(Uoo,i),2), t, sarch);
    3216      530504 :       gel(G,i) = t;
    3217             :     }
    3218             :   }
    3219      271065 :   return mkvec3(h, cyc, G);
    3220             : }
    3221             : 
    3222             : /* remove prime ideals of norm 2 with exponent 1 from factorization */
    3223             : static GEN
    3224      271752 : famat_strip2(GEN fa)
    3225             : {
    3226      271752 :   GEN P = gel(fa,1), E = gel(fa,2), Q, F;
    3227      271752 :   long l = lg(P), i, j;
    3228      271752 :   Q = cgetg(l, t_COL);
    3229      271748 :   F = cgetg(l, t_COL);
    3230      681355 :   for (i = j = 1; i < l; i++)
    3231             :   {
    3232      409603 :     GEN pr = gel(P,i), e = gel(E,i);
    3233      409603 :     if (!absequaliu(pr_get_p(pr), 2) || itou(e) != 1 || pr_get_f(pr) != 1)
    3234             :     {
    3235      370970 :       gel(Q,j) = pr;
    3236      370970 :       gel(F,j) = e; j++;
    3237             :     }
    3238             :   }
    3239      271752 :   setlg(Q,j);
    3240      271752 :   setlg(F,j); return mkmat2(Q,F);
    3241             : }
    3242             : static int
    3243      134107 : checkarchp(GEN v, long r1)
    3244             : {
    3245      134107 :   long i, l = lg(v);
    3246      134107 :   pari_sp av = avma;
    3247             :   GEN p;
    3248      134107 :   if (l == 1) return 1;
    3249       47171 :   if (l == 2) return v[1] > 0 && v[1] <= r1;
    3250       22021 :   p = zero_zv(r1);
    3251       66150 :   for (i = 1; i < l; i++)
    3252             :   {
    3253       44163 :     long j = v[i];
    3254       44163 :     if (j <= 0 || j > r1 || p[j]) return gc_long(av, 0);
    3255       44128 :     p[j] = 1;
    3256             :   }
    3257       21987 :   return gc_long(av, 1);
    3258             : }
    3259             : 
    3260             : /* True nf. Put ideal to form [[ideal,arch]] and set fa and fa2 to its
    3261             :  * factorization, archp to the indices of arch places */
    3262             : GEN
    3263      271745 : check_mod_factored(GEN nf, GEN ideal, GEN *fa_, GEN *fa2_, GEN *archp_, GEN MOD)
    3264             : {
    3265             :   GEN arch, x, fa, fa2, archp;
    3266             :   long R1;
    3267             : 
    3268      271745 :   R1 = nf_get_r1(nf);
    3269      271750 :   if (typ(ideal) == t_VEC && lg(ideal) == 3)
    3270             :   {
    3271      191563 :     arch = gel(ideal,2);
    3272      191563 :     ideal= gel(ideal,1);
    3273      191563 :     switch(typ(arch))
    3274             :     {
    3275       57456 :       case t_VEC:
    3276       57456 :         if (lg(arch) != R1+1)
    3277           7 :           pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
    3278       57449 :         archp = vec01_to_indices(arch);
    3279       57449 :         break;
    3280      134107 :       case t_VECSMALL:
    3281      134107 :         if (!checkarchp(arch, R1))
    3282          35 :           pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
    3283      134071 :         archp = arch;
    3284      134071 :         arch = indices_to_vec01(archp, R1);
    3285      134067 :         break;
    3286           0 :       default:
    3287           0 :         pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
    3288             :         return NULL;/*LCOV_EXCL_LINE*/
    3289             :     }
    3290             :   }
    3291             :   else
    3292             :   {
    3293       80187 :     arch = zerovec(R1);
    3294       80188 :     archp = cgetg(1, t_VECSMALL);
    3295             :   }
    3296      271701 :   if (MOD)
    3297             :   {
    3298      227083 :     if (typ(MOD) != t_INT) pari_err_TYPE("bnrinit [incorrect cycmod]", MOD);
    3299      227083 :     if (mpodd(MOD) && lg(archp) != 1)
    3300         231 :       MOD = shifti(MOD, 1); /* ensure elements of G^MOD are >> 0 */
    3301             :   }
    3302      271700 :   if (is_nf_factor(ideal))
    3303             :   {
    3304       53172 :     fa = ideal;
    3305       53172 :     x = factorbackprime(nf, gel(fa,1), gel(fa,2));
    3306             :   }
    3307             :   else
    3308             :   {
    3309      218526 :     fa = idealfactor(nf, ideal);
    3310      218543 :     x = ideal;
    3311             :   }
    3312      271715 :   if (typ(x) != t_MAT) x = idealhnf_shallow(nf, x);
    3313      271696 :   if (lg(x) == 1) pari_err_DOMAIN("Idealstar", "ideal","=",gen_0,x);
    3314      271696 :   if (typ(gcoeff(x,1,1)) != t_INT)
    3315           7 :     pari_err_DOMAIN("Idealstar","denominator(ideal)", "!=",gen_1,x);
    3316             : 
    3317      271689 :   fa2 = famat_strip2(fa);
    3318      271687 :   if (fa_ != NULL) *fa_ = fa;
    3319      271687 :   if (fa2_ != NULL) *fa2_ = fa2;
    3320      271687 :   if (fa2_ != NULL) *archp_ = archp;
    3321      271687 :   return mkvec2(x, arch);
    3322             : }
    3323             : 
    3324             : /* True nf. Compute [[ideal,arch], [h,[cyc],[gen]], idealfact, [liste], U]
    3325             :    flag may include nf_GEN | nf_INIT */
    3326             : static GEN
    3327      271116 : Idealstarmod_i(GEN nf, GEN ideal, long flag, GEN MOD)
    3328             : {
    3329             :   long i, nbp;
    3330      271116 :   GEN y, cyc, U, u1 = NULL, fa, fa2, sprk, x_arch, x, arch, archp, E, P, sarch, gen;
    3331             : 
    3332      271116 :   x_arch = check_mod_factored(nf, ideal, &fa, &fa2, &archp, MOD);
    3333      271057 :   x = gel(x_arch, 1);
    3334      271057 :   arch = gel(x_arch, 2);
    3335             : 
    3336      271057 :   sarch = nfarchstar(nf, x, archp);
    3337      271052 :   P = gel(fa2,1);
    3338      271052 :   E = gel(fa2,2);
    3339      271052 :   nbp = lg(P)-1;
    3340      271052 :   sprk = cgetg(nbp+1,t_VEC);
    3341      271059 :   if (nbp)
    3342             :   {
    3343      231783 :     GEN t = (lg(gel(fa,1))==2)? NULL: x; /* beware fa != fa2 */
    3344      231783 :     cyc = cgetg(nbp+2,t_VEC);
    3345      231772 :     gen = cgetg(nbp+1,t_VEC);
    3346      602076 :     for (i = 1; i <= nbp; i++)
    3347             :     {
    3348      370277 :       GEN L = sprkinit(nf, gel(P,i), itou(gel(E,i)), t, MOD);
    3349      370290 :       gel(sprk,i) = L;
    3350      370290 :       gel(cyc,i) = sprk_get_cyc(L);
    3351             :       /* true gens are congruent to those mod x AND positive at archp */
    3352      370290 :       gel(gen,i) = sprk_get_gen(L);
    3353             :     }
    3354      231799 :     gel(cyc,i) = sarch_get_cyc(sarch);
    3355      231799 :     cyc = shallowconcat1(cyc);
    3356      231804 :     gen = shallowconcat1(gen);
    3357      231807 :     cyc = ZV_snf_group(cyc, &U, (flag & nf_GEN)? &u1: NULL);
    3358             :   }
    3359             :   else
    3360             :   {
    3361       39276 :     cyc = sarch_get_cyc(sarch);
    3362       39276 :     gen = cgetg(1,t_VEC);
    3363       39277 :     U = matid(lg(cyc)-1);
    3364       39277 :     if (flag & nf_GEN) u1 = U;
    3365             :   }
    3366      271059 :   if (MOD) cyc = ZV_snf_gcd(cyc, MOD);
    3367      271031 :   y = bid_grp(nf, u1, cyc, gen, x, sarch);
    3368      271072 :   if (!(flag & nf_INIT)) return y;
    3369      270274 :   U = split_U(U, sprk);
    3370      540544 :   return mkvec5(mkvec2(x, arch), y, mkvec2(fa,fa2),
    3371      270270 :                 MOD? mkvec3(sprk, sarch, MOD): mkvec2(sprk, sarch),
    3372             :                 U);
    3373             : }
    3374             : 
    3375             : static long
    3376          63 : idealHNF_norm_pval(GEN x, GEN p)
    3377             : {
    3378          63 :   long i, v = 0, l = lg(x);
    3379         175 :   for (i = 1; i < l; i++) v += Z_pval(gcoeff(x,i,i), p);
    3380          63 :   return v;
    3381             : }
    3382             : static long
    3383          63 : sprk_get_k(GEN sprk)
    3384             : {
    3385             :   GEN pr, prk;
    3386          63 :   if (sprk_is_prime(sprk)) return 1;
    3387          63 :   pr = sprk_get_pr(sprk);
    3388          63 :   prk = sprk_get_prk(sprk);
    3389          63 :   return idealHNF_norm_pval(prk, pr_get_p(pr)) / pr_get_f(pr);
    3390             : }
    3391             : /* true nf, L a sprk */
    3392             : GEN
    3393          63 : sprk_to_bid(GEN nf, GEN L, long flag)
    3394             : {
    3395          63 :   GEN y, cyc, U, u1 = NULL, fa, fa2, arch, sarch, gen, sprk;
    3396             : 
    3397          63 :   arch = zerovec(nf_get_r1(nf));
    3398          63 :   fa = to_famat_shallow(sprk_get_pr(L), utoipos(sprk_get_k(L)));
    3399          63 :   sarch = nfarchstar(nf, NULL, cgetg(1, t_VECSMALL));
    3400          63 :   fa2 = famat_strip2(fa);
    3401          63 :   sprk = mkvec(L);
    3402          63 :   cyc = shallowconcat(sprk_get_cyc(L), sarch_get_cyc(sarch));
    3403          63 :   gen = sprk_get_gen(L);
    3404          63 :   cyc = ZV_snf_group(cyc, &U, (flag & nf_GEN)? &u1: NULL);
    3405          63 :   y = bid_grp(nf, u1, cyc, gen, NULL, sarch);
    3406          63 :   if (!(flag & nf_INIT)) return y;
    3407          63 :   return mkvec5(mkvec2(sprk_get_prk(L), arch), y, mkvec2(fa,fa2),
    3408             :                 mkvec2(sprk, sarch), split_U(U, sprk));
    3409             : }
    3410             : GEN
    3411      270837 : Idealstarmod(GEN nf, GEN ideal, long flag, GEN MOD)
    3412             : {
    3413      270837 :   pari_sp av = avma;
    3414      270837 :   nf = nf? checknf(nf): nfinit(pol_x(0), DEFAULTPREC);
    3415      270842 :   return gc_GEN(av, Idealstarmod_i(nf, ideal, flag, MOD));
    3416             : }
    3417             : GEN
    3418         938 : Idealstar(GEN nf, GEN ideal, long flag) { return Idealstarmod(nf, ideal, flag, NULL); }
    3419             : GEN
    3420         273 : Idealstarprk(GEN nf, GEN pr, long k, long flag)
    3421             : {
    3422         273 :   pari_sp av = avma;
    3423         273 :   GEN z = Idealstarmod_i(nf, mkmat2(mkcol(pr),mkcols(k)), flag, NULL);
    3424         273 :   return gc_GEN(av, z);
    3425             : }
    3426             : 
    3427             : /* FIXME: obsolete */
    3428             : GEN
    3429           0 : zidealstarinitgen(GEN nf, GEN ideal)
    3430           0 : { return Idealstar(nf,ideal, nf_INIT|nf_GEN); }
    3431             : GEN
    3432           0 : zidealstarinit(GEN nf, GEN ideal)
    3433           0 : { return Idealstar(nf,ideal, nf_INIT); }
    3434             : GEN
    3435           0 : zidealstar(GEN nf, GEN ideal)
    3436           0 : { return Idealstar(nf,ideal, nf_GEN); }
    3437             : 
    3438             : GEN
    3439         112 : idealstarmod(GEN nf, GEN ideal, long flag, GEN MOD)
    3440             : {
    3441         112 :   switch(flag)
    3442             :   {
    3443           0 :     case 0: return Idealstarmod(nf,ideal, nf_GEN, MOD);
    3444          98 :     case 1: return Idealstarmod(nf,ideal, nf_INIT, MOD);
    3445          14 :     case 2: return Idealstarmod(nf,ideal, nf_INIT|nf_GEN, MOD);
    3446           0 :     default: pari_err_FLAG("idealstar");
    3447             :   }
    3448             :   return NULL; /* LCOV_EXCL_LINE */
    3449             : }
    3450             : GEN
    3451           0 : idealstar0(GEN nf, GEN ideal,long flag) { return idealstarmod(nf, ideal, flag, NULL); }
    3452             : 
    3453             : GEN
    3454     2321363 : ZV_snf_gcd(GEN x, GEN mod)
    3455     5501006 : { pari_APPLY_same(gcdii(gel(x,i), mod)); }
    3456             : 
    3457             : /* assume a true bnf and bid */
    3458             : GEN
    3459      239959 : ideallog_units0(GEN bnf, GEN bid, GEN MOD)
    3460             : {
    3461      239959 :   GEN nf = bnf_get_nf(bnf), D, y, C, cyc;
    3462      239956 :   long j, lU = lg(bnf_get_logfu(bnf)); /* r1+r2 */
    3463             :   zlog_S S;
    3464      239955 :   init_zlog_mod(&S, bid, MOD);
    3465      239941 :   if (!S.hU) return zeromat(0,lU);
    3466      239941 :   cyc = bid_get_cyc(bid);
    3467      239936 :   D = nfsign_fu(bnf, bid_get_archp(bid));
    3468      239954 :   y = cgetg(lU, t_MAT);
    3469      239952 :   if ((C = bnf_build_cheapfu(bnf)))
    3470      400768 :   { for (j = 1; j < lU; j++) gel(y,j) = zlog(nf, gel(C,j), gel(D,j), &S); }
    3471             :   else
    3472             :   {
    3473          49 :     long i, l = lg(S.U), l0 = lg(S.sprk);
    3474             :     GEN X, U;
    3475          49 :     if (!(C = bnf_compactfu_mat(bnf))) bnf_build_units(bnf); /* error */
    3476          49 :     X = gel(C,1); U = gel(C,2);
    3477         147 :     for (j = 1; j < lU; j++) gel(y,j) = cgetg(l, t_COL);
    3478         126 :     for (i = 1; i < l0; i++)
    3479             :     {
    3480          77 :       GEN sprk = gel(S.sprk, i);
    3481          77 :       GEN Xi = sunits_makecoprime(X, sprk_get_pr(sprk), sprk_get_prk(sprk));
    3482         231 :       for (j = 1; j < lU; j++)
    3483         154 :         gcoeff(y,i,j) = famat_zlog_pr_coprime(nf, Xi, gel(U,j), sprk, MOD);
    3484             :     }
    3485          49 :     if (l0 != l)
    3486          56 :       for (j = 1; j < lU; j++) gcoeff(y,l0,j) = Flc_to_ZC(gel(D,j));
    3487             :   }
    3488      239947 :   y = vec_prepend(y, zlog(nf, bnf_get_tuU(bnf), nfsign_tu(bnf, S.archp), &S));
    3489      640823 :   for (j = 1; j <= lU; j++)
    3490      400891 :     gel(y,j) = ZV_ZV_mod(ZMV_ZCV_mul(S.U, gel(y,j)), cyc);
    3491      239932 :   return y;
    3492             : }
    3493             : GEN
    3494          84 : ideallog_units(GEN bnf, GEN bid)
    3495          84 : { return ideallog_units0(bnf, bid, NULL); }
    3496             : GEN
    3497         518 : log_prk_units(GEN nf, GEN D, GEN sprk)
    3498             : {
    3499         518 :   GEN L, Ltu = log_prk(nf, gel(D,1), sprk, NULL);
    3500         518 :   D = gel(D,2);
    3501         518 :   if (lg(D) != 3 || typ(gel(D,2)) != t_MAT) L = veclog_prk(nf, D, sprk);
    3502             :   else
    3503             :   {
    3504          21 :     GEN X = gel(D,1), U = gel(D,2);
    3505          21 :     long j, lU = lg(U);
    3506          21 :     X = sunits_makecoprime(X, sprk_get_pr(sprk), sprk_get_prk(sprk));
    3507          21 :     L = cgetg(lU, t_MAT);
    3508          63 :     for (j = 1; j < lU; j++)
    3509          42 :       gel(L,j) = famat_zlog_pr_coprime(nf, X, gel(U,j), sprk, NULL);
    3510             :   }
    3511         518 :   return vec_prepend(L, Ltu);
    3512             : }
    3513             : 
    3514             : static GEN
    3515     1521358 : ideallog_i(GEN nf, GEN x, zlog_S *S)
    3516             : {
    3517     1521358 :   pari_sp av = avma;
    3518             :   GEN y;
    3519     1521358 :   if (!S->hU) return cgetg(1, t_COL);
    3520     1518992 :   if (typ(x) == t_MAT)
    3521     1424576 :     y = famat_zlog(nf, x, NULL, S);
    3522             :   else
    3523       94416 :     y = zlog(nf, x, NULL, S);
    3524     1518987 :   y = ZMV_ZCV_mul(S->U, y);
    3525     1518988 :   return gc_upto(av, ZV_ZV_mod(y, bid_get_cyc(S->bid)));
    3526             : }
    3527             : GEN
    3528     1528039 : ideallogmod(GEN nf, GEN x, GEN bid, GEN mod)
    3529             : {
    3530             :   zlog_S S;
    3531     1528039 :   if (!nf)
    3532             :   {
    3533        6671 :     if (mod) pari_err_IMPL("Zideallogmod");
    3534        6671 :     return Zideallog(bid, x);
    3535             :   }
    3536     1521368 :   checkbid(bid); init_zlog_mod(&S, bid, mod);
    3537     1521359 :   return ideallog_i(checknf(nf), x, &S);
    3538             : }
    3539             : GEN
    3540       13769 : ideallog(GEN nf, GEN x, GEN bid) { return ideallogmod(nf, x, bid, NULL); }
    3541             : 
    3542             : /*************************************************************************/
    3543             : /**                                                                     **/
    3544             : /**               JOIN BID STRUCTURES, IDEAL LISTS                      **/
    3545             : /**                                                                     **/
    3546             : /*************************************************************************/
    3547             : /* bid1, bid2: for coprime modules m1 and m2 (without arch. part).
    3548             :  * Output: bid for m1 m2 */
    3549             : static GEN
    3550         469 : join_bid(GEN nf, GEN bid1, GEN bid2)
    3551             : {
    3552         469 :   pari_sp av = avma;
    3553             :   long nbgen, l1,l2;
    3554             :   GEN I1,I2, G1,G2, sprk1,sprk2, cyc1,cyc2, sarch;
    3555         469 :   GEN sprk, fa,fa2, U, cyc, y, u1 = NULL, x, gen;
    3556             : 
    3557         469 :   I1 = bid_get_ideal(bid1);
    3558         469 :   I2 = bid_get_ideal(bid2);
    3559         469 :   if (gequal1(gcoeff(I1,1,1))) return bid2; /* frequent trivial case */
    3560         259 :   G1 = bid_get_grp(bid1);
    3561         259 :   G2 = bid_get_grp(bid2);
    3562         259 :   x = idealmul(nf, I1,I2);
    3563         259 :   fa = famat_mul_shallow(bid_get_fact(bid1), bid_get_fact(bid2));
    3564         259 :   fa2= famat_mul_shallow(bid_get_fact2(bid1), bid_get_fact2(bid2));
    3565         259 :   sprk1 = bid_get_sprk(bid1);
    3566         259 :   sprk2 = bid_get_sprk(bid2);
    3567         259 :   sprk = shallowconcat(sprk1, sprk2);
    3568             : 
    3569         259 :   cyc1 = abgrp_get_cyc(G1); l1 = lg(cyc1);
    3570         259 :   cyc2 = abgrp_get_cyc(G2); l2 = lg(cyc2);
    3571         259 :   gen = (lg(G1)>3 && lg(G2)>3)? gen_1: NULL;
    3572         259 :   nbgen = l1+l2-2;
    3573         259 :   cyc = ZV_snf_group(shallowconcat(cyc1,cyc2), &U, gen? &u1: NULL);
    3574         259 :   if (nbgen)
    3575             :   {
    3576         259 :     GEN U1 = bid_get_U(bid1), U2 = bid_get_U(bid2);
    3577           0 :     U1 = l1==1? const_vec(lg(sprk1), cgetg(1,t_MAT))
    3578         259 :               : ZM_ZMV_mul(vecslice(U, 1, l1-1),   U1);
    3579           0 :     U2 = l2==1? const_vec(lg(sprk2), cgetg(1,t_MAT))
    3580         259 :               : ZM_ZMV_mul(vecslice(U, l1, nbgen), U2);
    3581         259 :     U = shallowconcat(U1, U2);
    3582             :   }
    3583             :   else
    3584           0 :     U = const_vec(lg(sprk), cgetg(1,t_MAT));
    3585             : 
    3586         259 :   if (gen)
    3587             :   {
    3588         259 :     GEN uv = zkchinese1init2(nf, I2, I1, x);
    3589         518 :     gen = shallowconcat(zkVchinese1(gel(uv,1), abgrp_get_gen(G1)),
    3590         259 :                         zkVchinese1(gel(uv,2), abgrp_get_gen(G2)));
    3591             :   }
    3592         259 :   sarch = bid_get_sarch(bid1); /* trivial */
    3593         259 :   y = bid_grp(nf, u1, cyc, gen, x, sarch);
    3594         259 :   x = mkvec2(x, bid_get_arch(bid1));
    3595         259 :   y = mkvec5(x, y, mkvec2(fa, fa2), mkvec2(sprk, sarch), U);
    3596         259 :   return gc_GEN(av,y);
    3597             : }
    3598             : 
    3599             : typedef struct _ideal_data {
    3600             :   GEN nf, emb, L, pr, prL, sgnU, archp;
    3601             : } ideal_data;
    3602             : 
    3603             : /* z <- ( z | f(v[i])_{i=1..#v} ) */
    3604             : static void
    3605      758431 : concat_join(GEN *pz, GEN v, GEN (*f)(ideal_data*,GEN), ideal_data *data)
    3606             : {
    3607      758431 :   long i, nz, lv = lg(v);
    3608             :   GEN z, Z;
    3609      758431 :   if (lv == 1) return;
    3610      223011 :   z = *pz; nz = lg(z)-1;
    3611      223011 :   *pz = Z = cgetg(lv + nz, typ(z));
    3612      371670 :   for (i = 1; i <=nz; i++) gel(Z,i) = gel(z,i);
    3613      223340 :   Z += nz;
    3614      492003 :   for (i = 1; i < lv; i++) gel(Z,i) = f(data, gel(v,i));
    3615             : }
    3616             : static GEN
    3617         469 : join_idealinit(ideal_data *D, GEN x)
    3618         469 : { return join_bid(D->nf, x, D->prL); }
    3619             : static GEN
    3620      268456 : join_ideal(ideal_data *D, GEN x)
    3621      268456 : { return idealmulpowprime(D->nf, x, D->pr, D->L); }
    3622             : static GEN
    3623         448 : join_unit(ideal_data *D, GEN x)
    3624             : {
    3625         448 :   GEN bid = join_idealinit(D, gel(x,1)), u = gel(x,2), v = mkvec(D->emb);
    3626         448 :   if (lg(u) != 1) v = shallowconcat(u, v);
    3627         448 :   return mkvec2(bid, v);
    3628             : }
    3629             : 
    3630             : GEN
    3631          49 : log_prk_units_init(GEN bnf)
    3632             : {
    3633          49 :   GEN U = bnf_has_fu(bnf);
    3634          49 :   if (U) U = matalgtobasis(bnf_get_nf(bnf), U);
    3635          21 :   else if (!(U = bnf_compactfu_mat(bnf))) (void)bnf_build_units(bnf);
    3636          49 :   return mkvec2(bnf_get_tuU(bnf), U);
    3637             : }
    3638             : /*  flag & nf_GEN : generators, otherwise no
    3639             :  *  flag &2 : units, otherwise no
    3640             :  *  flag &4 : ideals in HNF, otherwise bid
    3641             :  *  flag &8 : omit ideals which cannot be conductors (pr^1 with Npr=2) */
    3642             : static GEN
    3643       11333 : Ideallist(GEN bnf, ulong bound, long flag)
    3644             : {
    3645       11333 :   const long do_units = flag & 2, big_id = !(flag & 4), cond = flag & 8;
    3646       11333 :   const long istar_flag = (flag & nf_GEN) | nf_INIT;
    3647             :   pari_sp av;
    3648             :   long i, j;
    3649       11333 :   GEN nf, z, p, fa, id, BOUND, U, empty = cgetg(1,t_VEC);
    3650             :   forprime_t S;
    3651             :   ideal_data ID;
    3652             :   GEN (*join_z)(ideal_data*, GEN);
    3653             : 
    3654       11333 :   if (do_units)
    3655             :   {
    3656          21 :     bnf = checkbnf(bnf);
    3657          21 :     nf = bnf_get_nf(bnf);
    3658          21 :     join_z = &join_unit;
    3659             :   }
    3660             :   else
    3661             :   {
    3662       11312 :     nf = checknf(bnf);
    3663       11312 :     join_z = big_id? &join_idealinit: &join_ideal;
    3664             :   }
    3665       11333 :   if ((long)bound <= 0) return empty;
    3666       11333 :   id = matid(nf_get_degree(nf));
    3667       11333 :   if (big_id) id = Idealstar(nf,id, istar_flag);
    3668             : 
    3669             :   /* z[i] will contain all "objects" of norm i. Depending on flag, this means
    3670             :    * an ideal, a bid, or a couple [bid, log(units)]. Such objects are stored
    3671             :    * in vectors, computed one primary component at a time; join_z
    3672             :    * reconstructs the global object */
    3673       11333 :   BOUND = utoipos(bound);
    3674       11333 :   z = const_vec(bound, empty);
    3675       11333 :   U = do_units? log_prk_units_init(bnf): NULL;
    3676       11333 :   gel(z,1) = mkvec(U? mkvec2(id, empty): id);
    3677       11333 :   ID.nf = nf;
    3678             : 
    3679       11333 :   p = cgetipos(3);
    3680       11333 :   u_forprime_init(&S, 2, bound);
    3681       11333 :   av = avma;
    3682       92860 :   while ((p[2] = u_forprime_next(&S)))
    3683             :   {
    3684       81609 :     if (DEBUGLEVEL>1) err_printf("%ld ",p[2]);
    3685       81609 :     fa = idealprimedec_limit_norm(nf, p, BOUND);
    3686      163032 :     for (j = 1; j < lg(fa); j++)
    3687             :     {
    3688       81505 :       GEN pr = gel(fa,j), z2 = leafcopy(z);
    3689       81513 :       ulong Q, q = upr_norm(pr);
    3690             :       long l;
    3691       81512 :       ID.pr = ID.prL = pr;
    3692       81512 :       if (cond && q == 2) { l = 2; Q = 4; } else { l = 1; Q = q; }
    3693      184459 :       for (; Q <= bound; l++, Q *= q) /* add pr^l */
    3694             :       {
    3695             :         ulong iQ;
    3696      103039 :         ID.L = utoipos(l);
    3697      103037 :         if (big_id) {
    3698         210 :           ID.prL = Idealstarprk(nf, pr, l, istar_flag);
    3699         210 :           if (U)
    3700         189 :             ID.emb = Q == 2? empty
    3701         189 :                            : log_prk_units(nf, U, gel(bid_get_sprk(ID.prL),1));
    3702             :         }
    3703      861352 :         for (iQ = Q,i = 1; iQ <= bound; iQ += Q,i++)
    3704      758405 :           concat_join(&gel(z,iQ), gel(z2,i), join_z, &ID);
    3705             :       }
    3706             :     }
    3707       81527 :     if (gc_needed(av,1))
    3708             :     {
    3709          18 :       if(DEBUGMEM>1) pari_warn(warnmem,"Ideallist");
    3710          18 :       z = gc_GEN(av, z);
    3711             :     }
    3712             :   }
    3713       11333 :   return z;
    3714             : }
    3715             : GEN
    3716          63 : gideallist(GEN bnf, GEN B, long flag)
    3717             : {
    3718          63 :   pari_sp av = avma;
    3719          63 :   if (typ(B) != t_INT)
    3720             :   {
    3721           0 :     B = gfloor(B);
    3722           0 :     if (typ(B) != t_INT) pari_err_TYPE("ideallist", B);
    3723           0 :     if (signe(B) < 0) B = gen_0;
    3724             :   }
    3725          63 :   if (signe(B) < 0)
    3726             :   {
    3727          28 :     if (flag != 4) pari_err_IMPL("ideallist with bid for single norm");
    3728          28 :     return gc_GEN(av, ideals_by_norm(checknf(bnf), absi(B)));
    3729             :   }
    3730          35 :   if (flag < 0 || flag > 15) pari_err_FLAG("ideallist");
    3731          35 :   return gc_GEN(av, Ideallist(bnf, itou(B), flag));
    3732             : }
    3733             : GEN
    3734       11298 : ideallist0(GEN bnf, long bound, long flag)
    3735             : {
    3736       11298 :   pari_sp av = avma;
    3737       11298 :   if (flag < 0 || flag > 15) pari_err_FLAG("ideallist");
    3738       11298 :   return gc_GEN(av, Ideallist(bnf, bound, flag));
    3739             : }
    3740             : GEN
    3741       10563 : ideallist(GEN bnf,long bound) { return ideallist0(bnf,bound,4); }
    3742             : 
    3743             : /* bid = for module m (without arch. part), arch = archimedean part.
    3744             :  * Output: bid for [m,arch] */
    3745             : static GEN
    3746          42 : join_bid_arch(GEN nf, GEN bid, GEN archp)
    3747             : {
    3748          42 :   pari_sp av = avma;
    3749             :   GEN G, U;
    3750          42 :   GEN sprk, cyc, y, u1 = NULL, x, sarch, gen;
    3751             : 
    3752          42 :   checkbid(bid);
    3753          42 :   G = bid_get_grp(bid);
    3754          42 :   x = bid_get_ideal(bid);
    3755          42 :   sarch = nfarchstar(nf, bid_get_ideal(bid), archp);
    3756          42 :   sprk = bid_get_sprk(bid);
    3757             : 
    3758          42 :   gen = (lg(G)>3)? gel(G,3): NULL;
    3759          42 :   cyc = diagonal_shallow(shallowconcat(gel(G,2), sarch_get_cyc(sarch)));
    3760          42 :   cyc = ZM_snf_group(cyc, &U, gen? &u1: NULL);
    3761          42 :   y = bid_grp(nf, u1, cyc, gen, x, sarch);
    3762          42 :   U = split_U(U, sprk);
    3763          42 :   y = mkvec5(mkvec2(x, archp), y, gel(bid,3), mkvec2(sprk, sarch), U);
    3764          42 :   return gc_GEN(av,y);
    3765             : }
    3766             : static GEN
    3767          42 : join_arch(ideal_data *D, GEN x) {
    3768          42 :   return join_bid_arch(D->nf, x, D->archp);
    3769             : }
    3770             : static GEN
    3771          14 : join_archunit(ideal_data *D, GEN x) {
    3772          14 :   GEN bid = join_arch(D, gel(x,1)), u = gel(x,2), v = mkvec(D->emb);
    3773          14 :   if (lg(u) != 1) v = shallowconcat(u, v);
    3774          14 :   return mkvec2(bid, v);
    3775             : }
    3776             : 
    3777             : /* L from ideallist, add archimedean part */
    3778             : GEN
    3779          14 : ideallistarch(GEN bnf, GEN L, GEN arch)
    3780             : {
    3781             :   pari_sp av;
    3782          14 :   long i, j, l = lg(L), lz;
    3783             :   GEN v, z, V, nf;
    3784             :   ideal_data ID;
    3785             :   GEN (*join_z)(ideal_data*, GEN);
    3786             : 
    3787          14 :   if (typ(L) != t_VEC) pari_err_TYPE("ideallistarch",L);
    3788          14 :   if (l == 1) return cgetg(1,t_VEC);
    3789          14 :   z = gel(L,1);
    3790          14 :   if (typ(z) != t_VEC) pari_err_TYPE("ideallistarch",z);
    3791          14 :   z = gel(z,1); /* either a bid or [bid,U] */
    3792          14 :   ID.archp = vec01_to_indices(arch);
    3793          14 :   if (lg(z) == 3)
    3794             :   { /* [bid,U]: do units */
    3795           7 :     bnf = checkbnf(bnf); nf = bnf_get_nf(bnf);
    3796           7 :     if (typ(z) != t_VEC) pari_err_TYPE("ideallistarch",z);
    3797           7 :     ID.emb = zm_to_ZM( rowpermute(nfsign_units(bnf,NULL,1), ID.archp) );
    3798           7 :     join_z = &join_archunit;
    3799             :   }
    3800             :   else
    3801             :   {
    3802           7 :     join_z = &join_arch;
    3803           7 :     nf = checknf(bnf);
    3804             :   }
    3805          14 :   ID.nf = nf;
    3806          14 :   av = avma; V = cgetg(l, t_VEC);
    3807          63 :   for (i = 1; i < l; i++)
    3808             :   {
    3809          49 :     z = gel(L,i); lz = lg(z);
    3810          49 :     gel(V,i) = v = cgetg(lz,t_VEC);
    3811          91 :     for (j=1; j<lz; j++) gel(v,j) = join_z(&ID, gel(z,j));
    3812             :   }
    3813          14 :   return gc_GEN(av,V);
    3814             : }

Generated by: LCOV version 1.16