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 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.8.0 lcov report (development 19614-52e089f) Lines: 1314 1391 94.5 %
Date: 2016-09-28 05:54:17 Functions: 140 147 95.2 %
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. It is distributed in the hope that it will be useful, but WITHOUT
       8             : ANY WARRANTY WHATSOEVER.
       9             : 
      10             : Check the License for details. You should have received a copy of it, along
      11             : with the package; see the file 'COPYING'. If not, write to the Free Software
      12             : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      13             : 
      14             : /*******************************************************************/
      15             : /*                                                                 */
      16             : /*                       BASIC NF OPERATIONS                       */
      17             : /*                                                                 */
      18             : /*******************************************************************/
      19             : #include "pari.h"
      20             : #include "paripriv.h"
      21             : 
      22             : /*******************************************************************/
      23             : /*                                                                 */
      24             : /*                OPERATIONS OVER NUMBER FIELD ELEMENTS.           */
      25             : /*     represented as column vectors over the integral basis       */
      26             : /*                                                                 */
      27             : /*******************************************************************/
      28             : static GEN
      29    10626039 : get_tab(GEN nf, long *N)
      30             : {
      31    10626039 :   GEN tab = (typ(nf) == t_MAT)? nf: gel(nf,9);
      32    10626039 :   *N = nbrows(tab); return tab;
      33             : }
      34             : 
      35             : /* x != 0, y t_INT. Return x * y (not memory clean if x = 1) */
      36             : static GEN
      37   405518860 : _mulii(GEN x, GEN y) {
      38  1025211894 :   return is_pm1(x)? (signe(x) < 0)? negi(y): y
      39   619693034 :                   : mulii(x, y);
      40             : }
      41             : 
      42             : GEN
      43        2492 : tablemul_ei_ej(GEN M, long i, long j)
      44             : {
      45             :   long N;
      46        2492 :   GEN tab = get_tab(M, &N);
      47        2492 :   tab += (i-1)*N; return gel(tab,j);
      48             : }
      49             : 
      50             : /* Outputs x.ei, where ei is the i-th elt of the algebra basis.
      51             :  * x an RgV of correct length and arbitrary content (polynomials, scalars...).
      52             :  * M is the multiplication table ei ej = sum_k M_k^(i,j) ek */
      53             : GEN
      54        3255 : tablemul_ei(GEN M, GEN x, long i)
      55             : {
      56             :   long j, k, N;
      57             :   GEN v, tab;
      58             : 
      59        3255 :   if (i==1) return gcopy(x);
      60        3255 :   tab = get_tab(M, &N);
      61        3255 :   if (typ(x) != t_COL) { v = zerocol(N); gel(v,i) = gcopy(x); return v; }
      62        3255 :   tab += (i-1)*N; v = cgetg(N+1,t_COL);
      63             :   /* wi . x = [ sum_j tab[k,j] x[j] ]_k */
      64       20965 :   for (k=1; k<=N; k++)
      65             :   {
      66       17710 :     pari_sp av = avma;
      67       17710 :     GEN s = gen_0;
      68      121590 :     for (j=1; j<=N; j++)
      69             :     {
      70      103880 :       GEN c = gcoeff(tab,k,j);
      71      103880 :       if (!gequal0(c)) s = gadd(s, gmul(c, gel(x,j)));
      72             :     }
      73       17710 :     gel(v,k) = gerepileupto(av,s);
      74             :   }
      75        3255 :   return v;
      76             : }
      77             : /* as tablemul_ei, assume x a ZV of correct length */
      78             : GEN
      79     9355093 : zk_ei_mul(GEN nf, GEN x, long i)
      80             : {
      81             :   long j, k, N;
      82             :   GEN v, tab;
      83             : 
      84     9355093 :   if (i==1) return ZC_copy(x);
      85     9355079 :   tab = get_tab(nf, &N); tab += (i-1)*N;
      86     9355079 :   v = cgetg(N+1,t_COL);
      87    68718999 :   for (k=1; k<=N; k++)
      88             :   {
      89    59363920 :     pari_sp av = avma;
      90    59363920 :     GEN s = gen_0;
      91   736806480 :     for (j=1; j<=N; j++)
      92             :     {
      93   677442560 :       GEN c = gcoeff(tab,k,j);
      94   677442560 :       if (signe(c)) s = addii(s, _mulii(c, gel(x,j)));
      95             :     }
      96    59363920 :     gel(v,k) = gerepileuptoint(av, s);
      97             :   }
      98     9355079 :   return v;
      99             : }
     100             : 
     101             : /* table of multiplication by wi in R[w1,..., wN] */
     102             : GEN
     103        4375 : ei_multable(GEN TAB, long i)
     104             : {
     105             :   long k,N;
     106        4375 :   GEN m, tab = get_tab(TAB, &N);
     107        4375 :   tab += (i-1)*N;
     108        4375 :   m = cgetg(N+1,t_MAT);
     109        4375 :   for (k=1; k<=N; k++) gel(m,k) = gel(tab,k);
     110        4375 :   return m;
     111             : }
     112             : 
     113             : GEN
     114     3817119 : zk_multable(GEN nf, GEN x)
     115             : {
     116     3817119 :   long i, l = lg(x);
     117     3817119 :   GEN mul = cgetg(l,t_MAT);
     118     3817119 :   gel(mul,1) = x; /* assume w_1 = 1 */
     119     3817119 :   for (i=2; i<l; i++) gel(mul,i) = zk_ei_mul(nf,x,i);
     120     3817119 :   return mul;
     121             : }
     122             : GEN
     123         742 : multable(GEN M, GEN x)
     124             : {
     125             :   long i, N;
     126             :   GEN mul;
     127         742 :   if (typ(x) == t_MAT) return x;
     128           0 :   M = get_tab(M, &N);
     129           0 :   if (typ(x) != t_COL) return scalarmat(x, N);
     130           0 :   mul = cgetg(N+1,t_MAT);
     131           0 :   gel(mul,1) = x; /* assume w_1 = 1 */
     132           0 :   for (i=2; i<=N; i++) gel(mul,i) = tablemul_ei(M,x,i);
     133           0 :   return mul;
     134             : }
     135             : 
     136             : /* x integral in nf; table of multiplication by x in ZK = Z[w1,..., wN].
     137             :  * Return a t_INT if x is scalar, and a ZM otherwise */
     138             : GEN
     139     7995339 : zk_scalar_or_multable(GEN nf, GEN x)
     140             : {
     141     7995339 :   long tx = typ(x);
     142     7995339 :   if (tx == t_MAT || tx == t_INT) return x;
     143     2696891 :   x = nf_to_scalar_or_basis(nf, x);
     144     2696891 :   return (typ(x) == t_COL)? zk_multable(nf, x): x;
     145             : }
     146             : 
     147             : GEN
     148          42 : nftrace(GEN nf, GEN x)
     149             : {
     150          42 :   pari_sp av = avma;
     151          42 :   nf = checknf(nf);
     152          42 :   x = nf_to_scalar_or_basis(nf, x);
     153         105 :   x = (typ(x) == t_COL)? RgV_dotproduct(x, gel(nf_get_Tr(nf),1))
     154          63 :                        : gmulgs(x, nf_get_degree(nf));
     155          42 :   return gerepileupto(av, x);
     156             : }
     157             : GEN
     158         567 : rnfelttrace(GEN rnf, GEN x)
     159             : {
     160         567 :   pari_sp av = avma;
     161         567 :   checkrnf(rnf);
     162         567 :   x = rnfeltabstorel(rnf, x);
     163        1344 :   x = (typ(x) == t_POLMOD)? rnfeltdown(rnf, gtrace(x))
     164         868 :                           : gmulgs(x, rnf_get_degree(rnf));
     165         476 :   return gerepileupto(av, x);
     166             : }
     167             : 
     168             : /* assume nf is a genuine nf, fa a famat */
     169             : static GEN
     170           7 : famat_norm(GEN nf, GEN fa)
     171             : {
     172           7 :   pari_sp av = avma;
     173           7 :   GEN g = gel(fa,1), e = gel(fa,2), N = gen_1;
     174           7 :   long i, l = lg(g);
     175          21 :   for (i = 1; i < l; i++)
     176          14 :     N = gmul(N, powgi(nfnorm(nf, gel(g,i)), gel(e,i)));
     177           7 :   return gerepileupto(av, N);
     178             : }
     179             : GEN
     180       21186 : nfnorm(GEN nf, GEN x)
     181             : {
     182       21186 :   pari_sp av = avma;
     183       21186 :   nf = checknf(nf);
     184       21186 :   if (typ(x) == t_MAT) return famat_norm(nf, x);
     185       21179 :   x = nf_to_scalar_or_alg(nf, x);
     186       61213 :   x = (typ(x) == t_POL)? RgXQ_norm(x, nf_get_pol(nf))
     187       40034 :                        : gpowgs(x, nf_get_degree(nf));
     188       21179 :   return gerepileupto(av, x);
     189             : }
     190             : 
     191             : GEN
     192         231 : rnfeltnorm(GEN rnf, GEN x)
     193             : {
     194         231 :   pari_sp av = avma;
     195         231 :   checkrnf(rnf);
     196         231 :   x = rnfeltabstorel(rnf, x);
     197         378 :   x = (typ(x) == t_POLMOD)? rnfeltdown(rnf, gnorm(x))
     198         238 :                           : gpowgs(x, rnf_get_degree(rnf));
     199         140 :   return gerepileupto(av, x);
     200             : }
     201             : 
     202             : /* x + y in nf */
     203             : GEN
     204     1617399 : nfadd(GEN nf, GEN x, GEN y)
     205             : {
     206     1617399 :   pari_sp av = avma;
     207             :   GEN z;
     208             : 
     209     1617399 :   nf = checknf(nf);
     210     1617399 :   x = nf_to_scalar_or_basis(nf, x);
     211     1617399 :   y = nf_to_scalar_or_basis(nf, y);
     212     1617399 :   if (typ(x) != t_COL)
     213     1166667 :   { z = (typ(y) == t_COL)? RgC_Rg_add(y, x): gadd(x,y); }
     214             :   else
     215      450732 :   { z = (typ(y) == t_COL)? RgC_add(x, y): RgC_Rg_add(x, y); }
     216     1617399 :   return gerepileupto(av, z);
     217             : }
     218             : /* x - y in nf */
     219             : GEN
     220       68789 : nfsub(GEN nf, GEN x, GEN y)
     221             : {
     222       68789 :   pari_sp av = avma;
     223             :   GEN z;
     224             : 
     225       68789 :   nf = checknf(nf);
     226       68789 :   x = nf_to_scalar_or_basis(nf, x);
     227       68789 :   y = nf_to_scalar_or_basis(nf, y);
     228       68789 :   if (typ(x) != t_COL)
     229       24689 :   { z = (typ(y) == t_COL)? Rg_RgC_sub(x,y): gsub(x,y); }
     230             :   else
     231       44100 :   { z = (typ(y) == t_COL)? RgC_sub(x,y): RgC_Rg_sub(x,y); }
     232       68789 :   return gerepileupto(av, z);
     233             : }
     234             : 
     235             : /* product of x and y in nf */
     236             : GEN
     237     4276114 : nfmul(GEN nf, GEN x, GEN y)
     238             : {
     239             :   GEN z;
     240     4276114 :   pari_sp av = avma;
     241             : 
     242     4276114 :   if (x == y) return nfsqr(nf,x);
     243             : 
     244     3815479 :   nf = checknf(nf);
     245     3815479 :   x = nf_to_scalar_or_basis(nf, x);
     246     3815479 :   y = nf_to_scalar_or_basis(nf, y);
     247     3815479 :   if (typ(x) != t_COL)
     248             :   {
     249     3126371 :     if (isintzero(x)) return gen_0;
     250     2563480 :     z = (typ(y) == t_COL)? RgC_Rg_mul(y, x): gmul(x,y); }
     251             :   else
     252             :   {
     253      689108 :     if (typ(y) != t_COL)
     254             :     {
     255      467967 :       if (isintzero(y)) return gen_0;
     256      148911 :       z = RgC_Rg_mul(x, y);
     257             :     }
     258             :     else
     259             :     {
     260             :       GEN dx, dy;
     261      221141 :       x = Q_remove_denom(x, &dx);
     262      221141 :       y = Q_remove_denom(y, &dy);
     263      221141 :       z = nfmuli(nf,x,y);
     264      221141 :       dx = mul_denom(dx,dy);
     265      221141 :       if (dx) z = RgC_Rg_div(z, dx);
     266             :     }
     267             :   }
     268     2933532 :   return gerepileupto(av, z);
     269             : }
     270             : /* square of x in nf */
     271             : GEN
     272      601835 : nfsqr(GEN nf, GEN x)
     273             : {
     274      601835 :   pari_sp av = avma;
     275             :   GEN z;
     276             : 
     277      601835 :   nf = checknf(nf);
     278      601835 :   x = nf_to_scalar_or_basis(nf, x);
     279      601835 :   if (typ(x) != t_COL) z = gsqr(x);
     280             :   else
     281             :   {
     282             :     GEN dx;
     283       93649 :     x = Q_remove_denom(x, &dx);
     284       93649 :     z = nfsqri(nf,x);
     285       93649 :     if (dx) z = RgC_Rg_div(z, sqri(dx));
     286             :   }
     287      601835 :   return gerepileupto(av, z);
     288             : }
     289             : 
     290             : /* x a ZC, v a t_COL of ZC/Z */
     291             : GEN
     292      113490 : zkC_multable_mul(GEN v, GEN x)
     293             : {
     294      113490 :   long i, l = lg(v);
     295      113490 :   GEN y = cgetg(l, t_COL);
     296      409070 :   for (i = 1; i < l; i++)
     297             :   {
     298      295580 :     GEN c = gel(v,i);
     299      295580 :     if (typ(c)!=t_COL) {
     300           0 :       if (!isintzero(c)) c = ZC_Z_mul(gel(x,1), c);
     301             :     } else {
     302      295580 :       c = ZM_ZC_mul(x,c);
     303      295580 :       if (ZV_isscalar(c)) c = gel(c,1);
     304             :     }
     305      295580 :     gel(y,i) = c;
     306             :   }
     307      113490 :   return y;
     308             : }
     309             : 
     310             : GEN
     311       24728 : nfC_multable_mul(GEN v, GEN x)
     312             : {
     313       24728 :   long i, l = lg(v);
     314       24728 :   GEN y = cgetg(l, t_COL);
     315      143727 :   for (i = 1; i < l; i++)
     316             :   {
     317      118999 :     GEN c = gel(v,i);
     318      118999 :     if (typ(c)!=t_COL) {
     319       95383 :       if (!isintzero(c)) c = RgC_Rg_mul(gel(x,1), c);
     320             :     } else {
     321       23616 :       c = RgM_RgC_mul(x,c);
     322       23616 :       if (QV_isscalar(c)) c = gel(c,1);
     323             :     }
     324      118999 :     gel(y,i) = c;
     325             :   }
     326       24728 :   return y;
     327             : }
     328             : 
     329             : GEN
     330       76327 : nfC_nf_mul(GEN nf, GEN v, GEN x)
     331             : {
     332             :   long tx;
     333             :   GEN y;
     334             : 
     335       76327 :   x = nf_to_scalar_or_basis(nf, x);
     336       76327 :   tx = typ(x);
     337       76327 :   if (tx != t_COL)
     338             :   {
     339             :     long l, i;
     340       52635 :     if (tx == t_INT)
     341             :     {
     342       51340 :       long s = signe(x);
     343       51340 :       if (!s) return zerocol(lg(v)-1);
     344       48189 :       if (is_pm1(x)) return s > 0? leafcopy(v): RgC_neg(v);
     345             :     }
     346       13882 :     l = lg(v); y = cgetg(l, t_COL);
     347      108142 :     for (i=1; i < l; i++)
     348             :     {
     349       94260 :       GEN c = gel(v,i);
     350       94260 :       if (typ(c) != t_COL) c = gmul(c, x); else c = RgC_Rg_mul(c, x);
     351       94260 :       gel(y,i) = c;
     352             :     }
     353       13882 :     return y;
     354             :   }
     355             :   else
     356             :   {
     357             :     GEN dx;
     358       23692 :     x = zk_multable(nf, Q_remove_denom(x,&dx));
     359       23692 :     y = nfC_multable_mul(v, x);
     360       23692 :     return dx? RgC_Rg_div(y, dx): y;
     361             :   }
     362             : }
     363             : static GEN
     364        3339 : mulbytab(GEN M, GEN c)
     365        3339 : { return typ(c) == t_COL? RgM_RgC_mul(M,c): RgC_Rg_mul(gel(M,1), c); }
     366             : GEN
     367         742 : tablemulvec(GEN M, GEN x, GEN v)
     368             : {
     369             :   long l, i;
     370             :   GEN y;
     371             : 
     372         742 :   if (typ(x) == t_COL && RgV_isscalar(x))
     373             :   {
     374           0 :     x = gel(x,1);
     375           0 :     return typ(v) == t_POL? RgX_Rg_mul(v,x): RgV_Rg_mul(v,x);
     376             :   }
     377         742 :   x = multable(M, x); /* multiplication table by x */
     378         742 :   y = cgetg_copy(v, &l);
     379         742 :   if (typ(v) == t_POL)
     380             :   {
     381         742 :     y[1] = v[1];
     382         742 :     for (i=2; i < l; i++) gel(y,i) = mulbytab(x, gel(v,i));
     383         742 :     y = normalizepol(y);
     384             :   }
     385             :   else
     386             :   {
     387           0 :     for (i=1; i < l; i++) gel(y,i) = mulbytab(x, gel(v,i));
     388             :   }
     389         742 :   return y;
     390             : }
     391             : 
     392             : GEN
     393      314581 : zkmultable_capZ(GEN mx) { return Q_denom(zkmultable_inv(mx)); }
     394             : 
     395             : GEN
     396      333701 : zkmultable_inv(GEN mx)
     397      333701 : { return ZM_gauss(mx, col_ei(lg(mx)-1,1)); }
     398             : 
     399             : /* nf a true nf, x a ZC */
     400             : GEN
     401       19120 : zk_inv(GEN nf, GEN x) { return zkmultable_inv(zk_multable(nf,x)); }
     402             : 
     403             : /* inverse of x in nf */
     404             : GEN
     405       61495 : nfinv(GEN nf, GEN x)
     406             : {
     407       61495 :   pari_sp av = avma;
     408             :   GEN z;
     409             : 
     410       61495 :   nf = checknf(nf);
     411       61495 :   x = nf_to_scalar_or_basis(nf, x);
     412       61495 :   if (typ(x) == t_COL)
     413             :   {
     414             :     GEN d;
     415        6007 :     x = Q_remove_denom(x, &d);
     416        6007 :     z = zk_inv(nf, x);
     417        6007 :     if (d) z = RgC_Rg_mul(z, d);
     418             :   }
     419             :   else
     420       55488 :     z = ginv(x);
     421       61495 :   return gerepileupto(av, z);
     422             : }
     423             : 
     424             : /* quotient of x and y in nf */
     425             : GEN
     426       10962 : nfdiv(GEN nf, GEN x, GEN y)
     427             : {
     428       10962 :   pari_sp av = avma;
     429             :   GEN z;
     430             : 
     431       10962 :   nf = checknf(nf);
     432       10962 :   y = nf_to_scalar_or_basis(nf, y);
     433       10962 :   if (typ(y) != t_COL)
     434             :   {
     435        2324 :     x = nf_to_scalar_or_basis(nf, x);
     436        2324 :     z = (typ(x) == t_COL)? RgC_Rg_div(x, y): gdiv(x,y);
     437             :   }
     438             :   else
     439             :   {
     440             :     GEN d;
     441        8638 :     y = Q_remove_denom(y, &d);
     442        8638 :     z = nfmul(nf, x, zk_inv(nf,y));
     443        8638 :     if (d) z = RgC_Rg_mul(z, d);
     444             :   }
     445       10962 :   return gerepileupto(av, z);
     446             : }
     447             : 
     448             : /* product of INTEGERS (t_INT or ZC) x and y in nf
     449             :  * compute xy as ( sum_i x_i sum_j y_j m^{i,j}_k )_k */
     450             : GEN
     451      607898 : nfmuli(GEN nf, GEN x, GEN y)
     452             : {
     453             :   long i, j, k, N;
     454      607898 :   GEN s, v, TAB = get_tab(nf, &N);
     455             : 
     456      607898 :   if (typ(x) == t_INT) return (typ(y) == t_COL)? ZC_Z_mul(y, x): mulii(x,y);
     457      530890 :   if (typ(y) == t_INT) return ZC_Z_mul(x, y);
     458             :   /* both x and y are ZV */
     459      511154 :   v = cgetg(N+1,t_COL);
     460     2597280 :   for (k=1; k<=N; k++)
     461             :   {
     462     2086126 :     pari_sp av = avma;
     463     2086126 :     GEN TABi = TAB;
     464     2086126 :     if (k == 1)
     465      511154 :       s = mulii(gel(x,1),gel(y,1));
     466             :     else
     467     3149944 :       s = addii(mulii(gel(x,1),gel(y,k)),
     468     3149944 :                 mulii(gel(x,k),gel(y,1)));
     469    13553408 :     for (i=2; i<=N; i++)
     470             :     {
     471    11467282 :       GEN t, xi = gel(x,i);
     472    11467282 :       TABi += N;
     473    11467282 :       if (!signe(xi)) continue;
     474             : 
     475     7060063 :       t = NULL;
     476    86900257 :       for (j=2; j<=N; j++)
     477             :       {
     478    79840194 :         GEN p1, c = gcoeff(TABi, k, j); /* m^{i,j}_k */
     479    79840194 :         if (!signe(c)) continue;
     480    37208460 :         p1 = _mulii(c, gel(y,j));
     481    37208460 :         t = t? addii(t, p1): p1;
     482             :       }
     483     7060063 :       if (t) s = addii(s, mulii(xi, t));
     484             :     }
     485     2086126 :     gel(v,k) = gerepileuptoint(av,s);
     486             :   }
     487      511154 :   return v;
     488             : }
     489             : /* square of INTEGER (t_INT or ZC) x in nf */
     490             : GEN
     491      652940 : nfsqri(GEN nf, GEN x)
     492             : {
     493             :   long i, j, k, N;
     494      652940 :   GEN s, v, TAB = get_tab(nf, &N);
     495             : 
     496      652940 :   if (typ(x) == t_INT) return sqri(x);
     497      652940 :   v = cgetg(N+1,t_COL);
     498     5117197 :   for (k=1; k<=N; k++)
     499             :   {
     500     4464257 :     pari_sp av = avma;
     501     4464257 :     GEN TABi = TAB;
     502     4464257 :     if (k == 1)
     503      652940 :       s = sqri(gel(x,1));
     504             :     else
     505     3811317 :       s = shifti(mulii(gel(x,1),gel(x,k)), 1);
     506    53757605 :     for (i=2; i<=N; i++)
     507             :     {
     508    49293348 :       GEN p1, c, t, xi = gel(x,i);
     509    49293348 :       TABi += N;
     510    49293348 :       if (!signe(xi)) continue;
     511             : 
     512    14880253 :       c = gcoeff(TABi, k, i);
     513    14880253 :       t = signe(c)? _mulii(c,xi): NULL;
     514   240006055 :       for (j=i+1; j<=N; j++)
     515             :       {
     516   225125802 :         c = gcoeff(TABi, k, j);
     517   225125802 :         if (!signe(c)) continue;
     518   119189419 :         p1 = _mulii(c, shifti(gel(x,j),1));
     519   119189419 :         t = t? addii(t, p1): p1;
     520             :       }
     521    14880253 :       if (t) s = addii(s, mulii(xi, t));
     522             :     }
     523     4464257 :     gel(v,k) = gerepileuptoint(av,s);
     524             :   }
     525      652940 :   return v;
     526             : }
     527             : 
     528             : /* both x and y are RgV */
     529             : GEN
     530           0 : tablemul(GEN TAB, GEN x, GEN y)
     531             : {
     532             :   long i, j, k, N;
     533             :   GEN s, v;
     534           0 :   if (typ(x) != t_COL) return gmul(x, y);
     535           0 :   if (typ(y) != t_COL) return gmul(y, x);
     536           0 :   N = lg(x)-1;
     537           0 :   v = cgetg(N+1,t_COL);
     538           0 :   for (k=1; k<=N; k++)
     539             :   {
     540           0 :     pari_sp av = avma;
     541           0 :     GEN TABi = TAB;
     542           0 :     if (k == 1)
     543           0 :       s = gmul(gel(x,1),gel(y,1));
     544             :     else
     545           0 :       s = gadd(gmul(gel(x,1),gel(y,k)),
     546           0 :                gmul(gel(x,k),gel(y,1)));
     547           0 :     for (i=2; i<=N; i++)
     548             :     {
     549           0 :       GEN t, xi = gel(x,i);
     550           0 :       TABi += N;
     551           0 :       if (gequal0(xi)) continue;
     552             : 
     553           0 :       t = NULL;
     554           0 :       for (j=2; j<=N; j++)
     555             :       {
     556           0 :         GEN p1, c = gcoeff(TABi, k, j); /* m^{i,j}_k */
     557           0 :         if (gequal0(c)) continue;
     558           0 :         p1 = gmul(c, gel(y,j));
     559           0 :         t = t? gadd(t, p1): p1;
     560             :       }
     561           0 :       if (t) s = gadd(s, gmul(xi, t));
     562             :     }
     563           0 :     gel(v,k) = gerepileupto(av,s);
     564             :   }
     565           0 :   return v;
     566             : }
     567             : GEN
     568        6230 : tablesqr(GEN TAB, GEN x)
     569             : {
     570             :   long i, j, k, N;
     571             :   GEN s, v;
     572             : 
     573        6230 :   if (typ(x) != t_COL) return gsqr(x);
     574        6230 :   N = lg(x)-1;
     575        6230 :   v = cgetg(N+1,t_COL);
     576             : 
     577       45808 :   for (k=1; k<=N; k++)
     578             :   {
     579       39578 :     pari_sp av = avma;
     580       39578 :     GEN TABi = TAB;
     581       39578 :     if (k == 1)
     582        6230 :       s = gsqr(gel(x,1));
     583             :     else
     584       33348 :       s = gmul2n(gmul(gel(x,1),gel(x,k)), 1);
     585      265972 :     for (i=2; i<=N; i++)
     586             :     {
     587      226394 :       GEN p1, c, t, xi = gel(x,i);
     588      226394 :       TABi += N;
     589      226394 :       if (gequal0(xi)) continue;
     590             : 
     591       71505 :       c = gcoeff(TABi, k, i);
     592       71505 :       t = !gequal0(c)? gmul(c,xi): NULL;
     593      319200 :       for (j=i+1; j<=N; j++)
     594             :       {
     595      247695 :         c = gcoeff(TABi, k, j);
     596      247695 :         if (gequal0(c)) continue;
     597      131978 :         p1 = gmul(gmul2n(c,1), gel(x,j));
     598      131978 :         t = t? gadd(t, p1): p1;
     599             :       }
     600       71505 :       if (t) s = gadd(s, gmul(xi, t));
     601             :     }
     602       39578 :     gel(v,k) = gerepileupto(av,s);
     603             :   }
     604        6230 :   return v;
     605             : }
     606             : 
     607             : static GEN
     608       30380 : _mul(void *data, GEN x, GEN y) { return nfmuli((GEN)data,x,y); }
     609             : static GEN
     610      103778 : _sqr(void *data, GEN x) { return nfsqri((GEN)data,x); }
     611             : 
     612             : /* Compute z^n in nf, left-shift binary powering */
     613             : GEN
     614      119403 : nfpow(GEN nf, GEN z, GEN n)
     615             : {
     616      119403 :   pari_sp av = avma;
     617             :   long s;
     618             :   GEN x, cx;
     619             : 
     620      119403 :   if (typ(n)!=t_INT) pari_err_TYPE("nfpow",n);
     621      119403 :   nf = checknf(nf);
     622      119403 :   s = signe(n); if (!s) return gen_1;
     623      119403 :   x = nf_to_scalar_or_basis(nf, z);
     624      119403 :   if (typ(x) != t_COL) return powgi(x,n);
     625      108195 :   if (s < 0)
     626             :   { /* simplified nfinv */
     627             :     GEN d;
     628        1874 :     x = Q_remove_denom(x, &d);
     629        1874 :     x = zk_inv(nf, x);
     630        1874 :     x = primitive_part(x, &cx);
     631        1874 :     cx = mul_content(cx, d);
     632        1874 :     n = absi(n);
     633             :   }
     634             :   else
     635      106321 :     x = primitive_part(x, &cx);
     636      108195 :   x = gen_pow(x, n, (void*)nf, _sqr, _mul);
     637      108195 :   if (cx) x = gmul(x, powgi(cx, n));
     638      108195 :   return av==avma? gcopy(x): gerepileupto(av,x);
     639             : }
     640             : /* Compute z^n in nf, left-shift binary powering */
     641             : GEN
     642       31234 : nfpow_u(GEN nf, GEN z, ulong n)
     643             : {
     644       31234 :   pari_sp av = avma;
     645             :   GEN x, cx;
     646             : 
     647       31234 :   nf = checknf(nf);
     648       31234 :   if (!n) return gen_1;
     649       31234 :   x = nf_to_scalar_or_basis(nf, z);
     650       31234 :   if (typ(x) != t_COL) return gpowgs(x,n);
     651        4389 :   x = primitive_part(x, &cx);
     652        4389 :   x = gen_powu(x, n, (void*)nf, _sqr, _mul);
     653        4389 :   if (cx) x = gmul(x, powgi(cx, utoipos(n)));
     654        4389 :   return av==avma? gcopy(x): gerepileupto(av,x);
     655             : }
     656             : 
     657             : static GEN
     658      346962 : _nf_red(void *E, GEN x) { (void)E; return x; }
     659             : 
     660             : static GEN
     661     1511958 : _nf_add(void *E, GEN x, GEN y) { return nfadd((GEN)E,x,y); }
     662             : 
     663             : static GEN
     664       86359 : _nf_neg(void *E, GEN x) { (void)E; return gneg(x); }
     665             : 
     666             : static GEN
     667     1794086 : _nf_mul(void *E, GEN x, GEN y) { return nfmul((GEN)E,x,y); }
     668             : 
     669             : static GEN
     670        6020 : _nf_inv(void *E, GEN x) { return nfinv((GEN)E,x); }
     671             : 
     672             : static GEN
     673        1358 : _nf_s(void *E, long x) { (void)E; return stoi(x); }
     674             : 
     675             : static const struct bb_field nf_field={_nf_red,_nf_add,_nf_mul,_nf_neg,
     676             :                                         _nf_inv,&gequal0,_nf_s };
     677             : 
     678       24920 : const struct bb_field *get_nf_field(void **E, GEN nf)
     679       24920 : { *E = (void*)nf; return &nf_field; }
     680             : 
     681             : GEN
     682          14 : nfM_det(GEN nf, GEN M)
     683             : {
     684             :   void *E;
     685          14 :   const struct bb_field *S = get_nf_field(&E, nf);
     686          14 :   return gen_det(M, E, S);
     687             : }
     688             : GEN
     689        1344 : nfM_inv(GEN nf, GEN M)
     690             : {
     691             :   void *E;
     692        1344 :   const struct bb_field *S = get_nf_field(&E, nf);
     693        1344 :   return gen_Gauss(M, matid(lg(M)-1), E, S);
     694             : }
     695             : GEN
     696        1260 : nfM_mul(GEN nf, GEN A, GEN B)
     697             : {
     698             :   void *E;
     699        1260 :   const struct bb_field *S = get_nf_field(&E, nf);
     700        1260 :   return gen_matmul(A, B, E, S);
     701             : }
     702             : GEN
     703       22302 : nfM_nfC_mul(GEN nf, GEN A, GEN B)
     704             : {
     705             :   void *E;
     706       22302 :   const struct bb_field *S = get_nf_field(&E, nf);
     707       22302 :   return gen_matcolmul(A, B, E, S);
     708             : }
     709             : 
     710             : /* valuation of integral x (ZV), with resp. to prime ideal pr */
     711             : long
     712     5025792 : ZC_nfvalrem(GEN nf, GEN x, GEN pr, GEN *newx)
     713             : {
     714             :   long i, v, l;
     715     5025792 :   GEN r, y, p = pr_get_p(pr), mul = zk_scalar_or_multable(nf, pr_get_tau(pr));
     716             : 
     717             :   /* p inert */
     718     5025792 :   if (typ(mul) == t_INT) return newx? ZV_pvalrem(x, p, newx):ZV_pval(x, p);
     719     5019944 :   y = cgetg_copy(x, &l); /* will hold the new x */
     720     5019944 :   x = leafcopy(x);
     721     7409571 :   for(v=0;; v++)
     722             :   {
     723    25510074 :     for (i=1; i<l; i++)
     724             :     { /* is (x.b)[i] divisible by p ? */
     725    23120447 :       gel(y,i) = dvmdii(ZMrow_ZC_mul(mul,x,i),p,&r);
     726    23120447 :       if (r != gen_0) { if (newx) *newx = x; return v; }
     727             :     }
     728     2389627 :     swap(x, y);
     729     2389627 :   }
     730             : }
     731             : long
     732     4814822 : ZC_nfval(GEN nf, GEN x, GEN P)
     733     4814822 : { return ZC_nfvalrem(nf, x, P, NULL); }
     734             : 
     735             : /* v_P(x) != 0, x a ZV. Simpler version of ZC_nfvalrem */
     736             : int
     737      201859 : ZC_prdvd(GEN nf, GEN x, GEN P)
     738             : {
     739      201859 :   pari_sp av = avma;
     740             :   long i, l;
     741      201859 :   GEN p = pr_get_p(P), mul = zk_scalar_or_multable(nf, pr_get_tau(P));
     742      201859 :   if (typ(mul) == t_INT) return ZV_Z_dvd(x, p);
     743      201782 :   l = lg(x);
     744      825342 :   for (i=1; i<l; i++)
     745      753428 :     if (remii(ZMrow_ZC_mul(mul,x,i), p) != gen_0) { avma = av; return 0; }
     746       71914 :   avma = av; return 1;
     747             : }
     748             : 
     749             : int
     750          28 : pr_equal(GEN nf, GEN P, GEN Q)
     751             : {
     752          28 :   GEN gQ, p = pr_get_p(P);
     753          28 :   long e = pr_get_e(P), f = pr_get_f(P), n;
     754          28 :   if (!equalii(p, pr_get_p(Q)) || e != pr_get_e(Q) || f != pr_get_f(Q))
     755          14 :     return 0;
     756          14 :   gQ = pr_get_gen(Q); n = lg(gQ)-1;
     757          14 :   if (2*e*f > n) return 1; /* room for only one such pr */
     758           7 :   return ZV_equal(pr_get_gen(P), gQ) || ZC_prdvd(nf, gQ, P);
     759             : }
     760             : 
     761             : long
     762     1319976 : nfval(GEN nf, GEN x, GEN pr)
     763             : {
     764     1319976 :   pari_sp av = avma;
     765             :   long w, e;
     766             :   GEN cx, p;
     767             : 
     768     1319976 :   if (gequal0(x)) return LONG_MAX;
     769     1319248 :   nf = checknf(nf);
     770     1319248 :   checkprid(pr);
     771     1319248 :   p = pr_get_p(pr);
     772     1319248 :   e = pr_get_e(pr);
     773     1319248 :   x = nf_to_scalar_or_basis(nf, x);
     774     1319248 :   if (typ(x) != t_COL) return e*Q_pval(x,p);
     775      136857 :   x = Q_primitive_part(x, &cx);
     776      136857 :   w = ZC_nfval(nf,x,pr);
     777      136857 :   if (cx) w += e*Q_pval(cx,p);
     778      136857 :   avma = av; return w;
     779             : }
     780             : 
     781             : /* want to write p^v = uniformizer^(e*v) * z^v, z coprime to pr */
     782             : /* z := tau^e / p^(e-1), algebraic integer coprime to pr; return z^v */
     783             : static GEN
     784        4333 : powp(GEN nf, GEN pr, long v)
     785             : {
     786             :   GEN b, z;
     787             :   long e;
     788        4333 :   if (!v) return gen_1;
     789        4312 :   b = pr_get_tau(pr);
     790        4312 :   if (typ(b) == t_INT) return gen_1;
     791        1085 :   e = pr_get_e(pr);
     792        1085 :   z = gel(b,1);
     793        1085 :   if (e != 1) z = gdiv(nfpow_u(nf, z, e), powiu(pr_get_p(pr),e-1));
     794        1085 :   return nfpow_u(nf, z, v);
     795             : }
     796             : long
     797       15351 : nfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
     798             : {
     799       15351 :   pari_sp av = avma;
     800             :   long w, e;
     801             :   GEN cx, p, t;
     802             : 
     803       15351 :   if (!py) return nfval(nf,x,pr);
     804       15232 :   if (gequal0(x)) { *py = gcopy(x); return LONG_MAX; }
     805       15218 :   nf = checknf(nf);
     806       15218 :   checkprid(pr);
     807       15218 :   p = pr_get_p(pr);
     808       15218 :   e = pr_get_e(pr);
     809       15218 :   x = nf_to_scalar_or_basis(nf, x);
     810       15218 :   if (typ(x) != t_COL) {
     811        3500 :     w = Q_pvalrem(x,p, py);
     812        3500 :     if (!w) { *py = gerepilecopy(av, x); return 0; }
     813        3346 :     *py = gerepileupto(av, gmul(powp(nf, pr, w), *py));
     814        3346 :     return e*w;
     815             :   }
     816       11718 :   x = Q_primitive_part(x, &cx);
     817       11718 :   w = ZC_nfvalrem(nf,x,pr, py);
     818       11718 :   if (cx)
     819             :   {
     820         987 :     long v = Q_pvalrem(cx,p, &t);
     821         987 :     *py = nfmul(nf, *py, gmul(powp(nf,pr,v), t));
     822         987 :     *py = gerepileupto(av, *py);
     823         987 :     w += e*v;
     824             :   }
     825             :   else
     826       10731 :     *py = gerepilecopy(av, *py);
     827       11718 :   return w;
     828             : }
     829             : GEN
     830         147 : gpnfvalrem(GEN nf, GEN x, GEN pr, GEN *py)
     831             : {
     832         147 :   long v = nfvalrem(nf,x,pr,py);
     833         147 :   return v == LONG_MAX? mkoo(): stoi(v);
     834             : }
     835             : 
     836             : GEN
     837       49398 : coltoalg(GEN nf, GEN x)
     838             : {
     839       49398 :   return mkpolmod( coltoliftalg(nf, x), nf_get_pol(nf) );
     840             : }
     841             : 
     842             : GEN
     843       52451 : basistoalg(GEN nf, GEN x)
     844             : {
     845             :   GEN z, T;
     846             : 
     847       52451 :   nf = checknf(nf);
     848       52451 :   switch(typ(x))
     849             :   {
     850             :     case t_COL: {
     851       43259 :       pari_sp av = avma;
     852       43259 :       return gerepilecopy(av, coltoalg(nf, x));
     853             :     }
     854             :     case t_POLMOD:
     855         119 :       T = nf_get_pol(nf);
     856         119 :       if (!RgX_equal_var(T,gel(x,1)))
     857           0 :         pari_err_MODULUS("basistoalg", T,gel(x,1));
     858         119 :       return gcopy(x);
     859             :     case t_POL:
     860         574 :       T = nf_get_pol(nf);
     861         574 :       if (varn(T) != varn(x)) pari_err_VAR("basistoalg",x,T);
     862         574 :       z = cgetg(3,t_POLMOD);
     863         574 :       gel(z,1) = ZX_copy(T);
     864         574 :       gel(z,2) = RgX_rem(x, T); return z;
     865             :     case t_INT:
     866             :     case t_FRAC:
     867        8499 :       T = nf_get_pol(nf);
     868        8499 :       z = cgetg(3,t_POLMOD);
     869        8499 :       gel(z,1) = ZX_copy(T);
     870        8499 :       gel(z,2) = gcopy(x); return z;
     871             :     default:
     872           0 :       pari_err_TYPE("basistoalg",x);
     873           0 :       return NULL; /* not reached */
     874             :   }
     875             : }
     876             : 
     877             : /* Assume nf is a genuine nf. */
     878             : GEN
     879    18717263 : nf_to_scalar_or_basis(GEN nf, GEN x)
     880             : {
     881    18717263 :   switch(typ(x))
     882             :   {
     883             :     case t_INT: case t_FRAC:
     884    11471186 :       return x;
     885             :     case t_POLMOD:
     886       72289 :       x = checknfelt_mod(nf,x,"nf_to_scalar_or_basis");
     887       72219 :       if (typ(x) != t_POL) return x;
     888             :       /* fall through */
     889             :     case t_POL:
     890             :     {
     891      198779 :       GEN T = nf_get_pol(nf);
     892      198779 :       long l = lg(x);
     893      198779 :       if (varn(x) != varn(T)) pari_err_VAR("nf_to_scalar_or_basis", x,T);
     894      198723 :       if (l >= lg(T)) { x = RgX_rem(x, T); l = lg(x); }
     895      198723 :       if (l == 2) return gen_0;
     896      141834 :       if (l == 3) return gel(x,2);
     897      108698 :       return poltobasis(nf,x);
     898             :     }
     899             :     case t_COL:
     900     6995743 :       if (lg(x) != lg(nf_get_zk(nf))) break;
     901     6995680 :       return QV_isscalar(x)? gel(x,1): x;
     902             :   }
     903          70 :   pari_err_TYPE("nf_to_scalar_or_basis",x);
     904           0 :   return NULL; /* not reached */
     905             : }
     906             : /* Let x be a polynomial with coefficients in Q or nf. Return the same
     907             :  * polynomial with coefficients expressed as vectors (on the integral basis).
     908             :  * No consistency checks, not memory-clean. */
     909             : GEN
     910        2633 : RgX_to_nfX(GEN nf, GEN x)
     911             : {
     912             :   long i, l;
     913        2633 :   GEN y = cgetg_copy(x, &l); y[1] = x[1];
     914        2633 :   for (i=2; i<l; i++) gel(y,i) = nf_to_scalar_or_basis(nf, gel(x,i));
     915        2633 :   return y;
     916             : }
     917             : 
     918             : /* Assume nf is a genuine nf. */
     919             : GEN
     920       85849 : nf_to_scalar_or_alg(GEN nf, GEN x)
     921             : {
     922       85849 :   switch(typ(x))
     923             :   {
     924             :     case t_INT: case t_FRAC:
     925        5963 :       return x;
     926             :     case t_POLMOD:
     927        1141 :       x = checknfelt_mod(nf,x,"nf_to_scalar_or_alg");
     928        1141 :       if (typ(x) != t_POL) return x;
     929             :       /* fall through */
     930             :     case t_POL:
     931             :     {
     932       12489 :       GEN T = nf_get_pol(nf);
     933       12489 :       long l = lg(x);
     934       12489 :       if (varn(x) != varn(T)) pari_err_VAR("nf_to_scalar_or_alg", x,T);
     935       12489 :       if (l >= lg(T)) { x = RgX_rem(x, T); l = lg(x); }
     936       12489 :       if (l == 2) return gen_0;
     937       12489 :       if (l == 3) return gel(x,2);
     938       12279 :       return x;
     939             :     }
     940             :     case t_COL:
     941       67341 :       if (lg(x) != lg(nf_get_zk(nf))) break;
     942       67341 :       return QV_isscalar(x)? gel(x,1): coltoliftalg(nf, x);
     943             :   }
     944          49 :   pari_err_TYPE("nf_to_scalar_or_alg",x);
     945           0 :   return NULL; /* not reached */
     946             : }
     947             : 
     948             : /* gmul(A, RgX_to_RgC(x)), A t_MAT (or t_VEC) of compatible dimensions */
     949             : GEN
     950     1445034 : mulmat_pol(GEN A, GEN x)
     951             : {
     952             :   long i,l;
     953             :   GEN z;
     954     1445034 :   if (typ(x) != t_POL) return gmul(x,gel(A,1)); /* scalar */
     955     1444915 :   l=lg(x)-1; if (l == 1) return typ(A)==t_VEC? gen_0: zerocol(nbrows(A));
     956     1443955 :   x++; z = gmul(gel(x,1), gel(A,1));
     957     6899164 :   for (i=2; i<l ; i++)
     958     5455209 :     if (!gequal0(gel(x,i))) z = gadd(z, gmul(gel(x,i), gel(A,i)));
     959     1443955 :   return z;
     960             : }
     961             : 
     962             : /* x a t_POL, nf a genuine nf. No garbage collecting. No check.  */
     963             : GEN
     964     1304518 : poltobasis(GEN nf, GEN x)
     965             : {
     966     1304518 :   GEN P = nf_get_pol(nf);
     967     1304518 :   if (varn(x) != varn(P)) pari_err_VAR( "poltobasis", x,P);
     968     1304462 :   if (degpol(x) >= degpol(P)) x = RgX_rem(x,P);
     969     1304462 :   return mulmat_pol(nf_get_invzk(nf), x);
     970             : }
     971             : 
     972             : GEN
     973       65517 : algtobasis(GEN nf, GEN x)
     974             : {
     975             :   pari_sp av;
     976             : 
     977       65517 :   nf = checknf(nf);
     978       65517 :   switch(typ(x))
     979             :   {
     980             :     case t_POLMOD:
     981       39361 :       if (!RgX_equal_var(nf_get_pol(nf),gel(x,1)))
     982           7 :         pari_err_MODULUS("algtobasis", nf_get_pol(nf),gel(x,1));
     983       39354 :       x = gel(x,2);
     984       39354 :       switch(typ(x))
     985             :       {
     986             :         case t_INT:
     987        2898 :         case t_FRAC: return scalarcol(x, nf_get_degree(nf));
     988             :         case t_POL:
     989       36456 :           av = avma;
     990       36456 :           return gerepileupto(av,poltobasis(nf,x));
     991             :       }
     992           0 :       break;
     993             : 
     994             :     case t_POL:
     995        9248 :       av = avma;
     996        9248 :       return gerepileupto(av,poltobasis(nf,x));
     997             : 
     998             :     case t_COL:
     999        7409 :       if (lg(x)-1 != nf_get_degree(nf)) pari_err_DIM("nfalgtobasis");
    1000        7409 :       return gcopy(x);
    1001             : 
    1002             :     case t_INT:
    1003        9499 :     case t_FRAC: return scalarcol(x, nf_get_degree(nf));
    1004             :   }
    1005           0 :   pari_err_TYPE("algtobasis",x);
    1006           0 :   return NULL; /* not reached */
    1007             : }
    1008             : 
    1009             : GEN
    1010       35637 : rnfbasistoalg(GEN rnf,GEN x)
    1011             : {
    1012       35637 :   const char *f = "rnfbasistoalg";
    1013             :   long lx, i;
    1014       35637 :   pari_sp av = avma;
    1015             :   GEN z, nf, relpol, T;
    1016             : 
    1017       35637 :   checkrnf(rnf);
    1018       35637 :   nf = rnf_get_nf(rnf);
    1019       35637 :   T = nf_get_pol(nf);
    1020       35637 :   relpol = QXQX_to_mod_shallow(rnf_get_pol(rnf), T);
    1021       35637 :   switch(typ(x))
    1022             :   {
    1023             :     case t_COL:
    1024         798 :       z = cgetg_copy(x, &lx);
    1025        2338 :       for (i=1; i<lx; i++)
    1026             :       {
    1027        1589 :         GEN c = nf_to_scalar_or_alg(nf, gel(x,i));
    1028        1540 :         if (typ(c) == t_POL) c = mkpolmod(c,T);
    1029        1540 :         gel(z,i) = c;
    1030             :       }
    1031         749 :       z = RgV_RgC_mul(gel(rnf_get_zk(rnf),1), z);
    1032         686 :       return gerepileupto(av, gmodulo(z,relpol));
    1033             : 
    1034             :     case t_POLMOD:
    1035       23688 :       x = polmod_nffix(f, rnf, x, 0);
    1036       23478 :       if (typ(x) != t_POL) break;
    1037        9555 :       retmkpolmod(RgX_copy(x), RgX_copy(relpol));
    1038             :     case t_POL:
    1039         819 :       if (varn(x) == varn(T)) { RgX_check_QX(x,f); x = gmodulo(x,T); break; }
    1040         595 :       if (varn(x) == varn(relpol))
    1041             :       {
    1042         546 :         x = RgX_nffix(f,nf_get_pol(nf),x,0);
    1043         546 :         return gmodulo(x, relpol);
    1044             :       }
    1045          49 :       pari_err_VAR(f, x,relpol);
    1046             :   }
    1047       24430 :   retmkpolmod(scalarpol(x, varn(relpol)), RgX_copy(relpol));
    1048             : }
    1049             : 
    1050             : GEN
    1051         833 : matbasistoalg(GEN nf,GEN x)
    1052             : {
    1053             :   long i, j, li, lx;
    1054         833 :   GEN z = cgetg_copy(x, &lx);
    1055             : 
    1056         833 :   if (lx == 1) return z;
    1057         826 :   switch(typ(x))
    1058             :   {
    1059             :     case t_VEC: case t_COL:
    1060          28 :       for (i=1; i<lx; i++) gel(z,i) = basistoalg(nf, gel(x,i));
    1061          28 :       return z;
    1062         798 :     case t_MAT: break;
    1063           0 :     default: pari_err_TYPE("matbasistoalg",x);
    1064             :   }
    1065         798 :   li = lgcols(x);
    1066        2933 :   for (j=1; j<lx; j++)
    1067             :   {
    1068        2135 :     GEN c = cgetg(li,t_COL), xj = gel(x,j);
    1069        2135 :     gel(z,j) = c;
    1070        2135 :     for (i=1; i<li; i++) gel(c,i) = basistoalg(nf, gel(xj,i));
    1071             :   }
    1072         798 :   return z;
    1073             : }
    1074             : 
    1075             : GEN
    1076        1771 : matalgtobasis(GEN nf,GEN x)
    1077             : {
    1078             :   long i, j, li, lx;
    1079        1771 :   GEN z = cgetg_copy(x, &lx);
    1080             : 
    1081        1771 :   if (lx == 1) return z;
    1082        1715 :   switch(typ(x))
    1083             :   {
    1084             :     case t_VEC: case t_COL:
    1085        1708 :       for (i=1; i<lx; i++) gel(z,i) = algtobasis(nf, gel(x,i));
    1086        1708 :       return z;
    1087           7 :     case t_MAT: break;
    1088           0 :     default: pari_err_TYPE("matalgtobasis",x);
    1089             :   }
    1090           7 :   li = lgcols(x);
    1091          14 :   for (j=1; j<lx; j++)
    1092             :   {
    1093           7 :     GEN c = cgetg(li,t_COL), xj = gel(x,j);
    1094           7 :     gel(z,j) = c;
    1095           7 :     for (i=1; i<li; i++) gel(c,i) = algtobasis(nf, gel(xj,i));
    1096             :   }
    1097           7 :   return z;
    1098             : }
    1099             : GEN
    1100        3276 : RgM_to_nfM(GEN nf,GEN x)
    1101             : {
    1102             :   long i, j, li, lx;
    1103        3276 :   GEN z = cgetg_copy(x, &lx);
    1104             : 
    1105        3276 :   if (lx == 1) return z;
    1106        3276 :   li = lgcols(x);
    1107       23800 :   for (j=1; j<lx; j++)
    1108             :   {
    1109       20524 :     GEN c = cgetg(li,t_COL), xj = gel(x,j);
    1110       20524 :     gel(z,j) = c;
    1111       20524 :     for (i=1; i<li; i++) gel(c,i) = nf_to_scalar_or_basis(nf, gel(xj,i));
    1112             :   }
    1113        3276 :   return z;
    1114             : }
    1115             : GEN
    1116       38254 : RgC_to_nfC(GEN nf,GEN x)
    1117             : {
    1118       38254 :   long i, lx = lg(x);
    1119       38254 :   GEN z = cgetg(lx, t_COL);
    1120       38254 :   for (i=1; i<lx; i++) gel(z,i) = nf_to_scalar_or_basis(nf, gel(x,i));
    1121       38254 :   return z;
    1122             : }
    1123             : 
    1124             : /* x a t_POLMOD, supposedly in rnf = K[z]/(T), K = Q[y]/(Tnf) */
    1125             : GEN
    1126       60529 : polmod_nffix(const char *f, GEN rnf, GEN x, int lift)
    1127       60529 : { return polmod_nffix2(f, rnf_get_nfpol(rnf), rnf_get_pol(rnf), x,lift); }
    1128             : GEN
    1129       60620 : polmod_nffix2(const char *f, GEN T, GEN relpol, GEN x, int lift)
    1130             : {
    1131       60620 :   if (RgX_equal_var(gel(x,1),relpol))
    1132             :   {
    1133       55370 :     x = gel(x,2);
    1134       55370 :     if (typ(x) == t_POL && varn(x) == varn(relpol))
    1135             :     {
    1136       39963 :       x = RgX_nffix(f, T, x, lift);
    1137       39963 :       switch(lg(x))
    1138             :       {
    1139       11130 :         case 2: return gen_0;
    1140        3913 :         case 3: return gel(x,2);
    1141             :       }
    1142       24920 :       return x;
    1143             :     }
    1144             :   }
    1145       20657 :   return Rg_nffix(f, T, x, lift);
    1146             : }
    1147             : GEN
    1148        1176 : rnfalgtobasis(GEN rnf,GEN x)
    1149             : {
    1150        1176 :   const char *f = "rnfalgtobasis";
    1151        1176 :   pari_sp av = avma;
    1152             :   GEN T, relpol;
    1153             : 
    1154        1176 :   checkrnf(rnf);
    1155        1176 :   relpol = rnf_get_pol(rnf);
    1156        1176 :   T = rnf_get_nfpol(rnf);
    1157        1176 :   switch(typ(x))
    1158             :   {
    1159             :     case t_COL:
    1160          49 :       if (lg(x)-1 != rnf_get_degree(rnf)) pari_err_DIM(f);
    1161          28 :       x = RgV_nffix(f, T, x, 0);
    1162          21 :       return gerepilecopy(av, x);
    1163             : 
    1164             :     case t_POLMOD:
    1165        1043 :       x = polmod_nffix(f, rnf, x, 0);
    1166        1001 :       if (typ(x) != t_POL) break;
    1167         707 :       return gerepileupto(av, mulmat_pol(rnf_get_invzk(rnf), x));
    1168             :     case t_POL:
    1169          56 :       if (varn(x) == varn(T)) { RgX_check_QX(x,f); x = mkpolmod(x,T); break; }
    1170          35 :       x = RgX_nffix(f, T, x, 0);
    1171          28 :       if (degpol(x) >= degpol(relpol)) x = RgX_rem(x,relpol);
    1172          28 :       return gerepileupto(av, mulmat_pol(rnf_get_invzk(rnf), x));
    1173             :   }
    1174         336 :   return gerepileupto(av, scalarcol(x, rnf_get_degree(rnf)));
    1175             : }
    1176             : 
    1177             : /* Given a and b in nf, gives an algebraic integer y in nf such that a-b.y
    1178             :  * is "small" */
    1179             : GEN
    1180         259 : nfdiveuc(GEN nf, GEN a, GEN b)
    1181             : {
    1182         259 :   pari_sp av = avma;
    1183         259 :   a = nfdiv(nf,a,b);
    1184         259 :   return gerepileupto(av, ground(a));
    1185             : }
    1186             : 
    1187             : /* Given a and b in nf, gives a "small" algebraic integer r in nf
    1188             :  * of the form a-b.y */
    1189             : GEN
    1190         259 : nfmod(GEN nf, GEN a, GEN b)
    1191             : {
    1192         259 :   pari_sp av = avma;
    1193         259 :   GEN p1 = gneg_i(nfmul(nf,b,ground(nfdiv(nf,a,b))));
    1194         259 :   return gerepileupto(av, nfadd(nf,a,p1));
    1195             : }
    1196             : 
    1197             : /* Given a and b in nf, gives a two-component vector [y,r] in nf such
    1198             :  * that r=a-b.y is "small". */
    1199             : GEN
    1200         259 : nfdivrem(GEN nf, GEN a, GEN b)
    1201             : {
    1202         259 :   pari_sp av = avma;
    1203         259 :   GEN p1,z, y = ground(nfdiv(nf,a,b));
    1204             : 
    1205         259 :   p1 = gneg_i(nfmul(nf,b,y));
    1206         259 :   z = cgetg(3,t_VEC);
    1207         259 :   gel(z,1) = gcopy(y);
    1208         259 :   gel(z,2) = nfadd(nf,a,p1); return gerepileupto(av, z);
    1209             : }
    1210             : 
    1211             : /*************************************************************************/
    1212             : /**                                                                     **/
    1213             : /**                           (Z_K/I)^*                                 **/
    1214             : /**                                                                     **/
    1215             : /*************************************************************************/
    1216             : /* return sign(sigma_k(x)), x t_COL (integral, primitive) */
    1217             : static long
    1218      378751 : eval_sign(GEN M, GEN x, long k)
    1219             : {
    1220      378751 :   long i, l = lg(x);
    1221      378751 :   GEN z = gel(x,1); /* times M[k,1], which is 1 */
    1222      378751 :   for (i = 2; i < l; i++) z = mpadd(z, mpmul(gcoeff(M,k,i), gel(x,i)));
    1223      378751 :   if (realprec(z) < DEFAULTPREC) pari_err_PREC("nfsign_arch");
    1224      378751 :   return signe(z);
    1225             : }
    1226             : 
    1227             : /* sigma_k(x), assuming x not rational (or nf != Q) */
    1228             : static GEN
    1229         287 : nfembed_i(GEN nf, GEN x, long k)
    1230             : {
    1231             :   long i, l;
    1232             :   GEN z, M;
    1233         287 :   M = nf_get_M(nf); l = lg(M); /* > 2 */
    1234         287 :   z = gel(x,1);
    1235         287 :   for (i=2; i<l; i++) z = gadd(z, gmul(gcoeff(M,k,i), gel(x,i)));
    1236         287 :   return z;
    1237             : }
    1238             : GEN
    1239        1568 : nfembed(GEN nf, GEN x, long k)
    1240             : {
    1241        1568 :   pari_sp av = avma;
    1242        1568 :   nf = checknf(nf);
    1243        1568 :   x = nf_to_scalar_or_basis(nf,x);
    1244        1568 :   if (typ(x) != t_COL) return gerepilecopy(av, x);
    1245           0 :   return gerepileupto(av, nfembed_i(nf,x,k));
    1246             : }
    1247             : 
    1248             : /* pl : requested signs for real embeddings, 0 = no sign constraint */
    1249             : /* FIXME: not rigorous */
    1250             : int
    1251        1113 : nfchecksigns(GEN nf, GEN x, GEN pl)
    1252             : {
    1253        1113 :   pari_sp av = avma;
    1254        1113 :   long l = lg(pl), i;
    1255        1113 :   nf = checknf(nf);
    1256        1113 :   x = nf_to_scalar_or_basis(nf,x);
    1257        1113 :   if (typ(x) != t_COL)
    1258             :   {
    1259         791 :     long s = gsigne(x);
    1260        1631 :     for (i = 1; i < l; i++)
    1261        1036 :       if (pl[i] && pl[i] != s) { avma = av; return 0; }
    1262             :   }
    1263             :   else
    1264             :   {
    1265         525 :     for (i = 1; i < l; i++)
    1266         322 :       if (pl[i] && pl[i] != gsigne(nfembed_i(nf,x,i))) { avma = av; return 0; }
    1267             :   }
    1268         798 :   avma = av; return 1;
    1269             : }
    1270             : 
    1271             : GEN
    1272         595 : vecsmall01_to_indices(GEN v)
    1273             : {
    1274         595 :   long i, k, l = lg(v);
    1275         595 :   GEN p = new_chunk(l) + l;
    1276        1526 :   for (k=1, i=l-1; i; i--)
    1277         931 :     if (v[i]) { *--p = i; k++; }
    1278         595 :   *--p = evallg(k) | evaltyp(t_VECSMALL);
    1279         595 :   avma = (pari_sp)p; return p;
    1280             : }
    1281             : GEN
    1282      532468 : vec01_to_indices(GEN v)
    1283             : {
    1284             :   long i, k, l;
    1285             :   GEN p;
    1286             : 
    1287      532468 :   switch (typ(v))
    1288             :   {
    1289      429778 :    case t_VECSMALL: return v;
    1290      102690 :    case t_VEC: break;
    1291           0 :    default: pari_err_TYPE("vec01_to_indices",v);
    1292             :   }
    1293      102690 :   l = lg(v);
    1294      102690 :   p = new_chunk(l) + l;
    1295      361984 :   for (k=1, i=l-1; i; i--)
    1296      259294 :     if (signe(gel(v,i))) { *--p = i; k++; }
    1297      102690 :   *--p = evallg(k) | evaltyp(t_VECSMALL);
    1298      102690 :   avma = (pari_sp)p; return p;
    1299             : }
    1300             : GEN
    1301        4452 : indices_to_vec01(GEN p, long r)
    1302             : {
    1303        4452 :   long i, l = lg(p);
    1304        4452 :   GEN v = zerovec(r);
    1305        4452 :   for (i = 1; i < l; i++) gel(v, p[i]) = gen_1;
    1306        4452 :   return v;
    1307             : }
    1308             : 
    1309             : /* return (column) vector of R1 signatures of x (0 or 1) */
    1310             : GEN
    1311      525475 : nfsign_arch(GEN nf, GEN x, GEN arch)
    1312             : {
    1313      525475 :   GEN M, V, archp = vec01_to_indices(arch);
    1314      525475 :   long i, s, n = lg(archp)-1;
    1315             :   pari_sp av;
    1316             : 
    1317      525475 :   if (!n) return cgetg(1,t_VECSMALL);
    1318      416075 :   nf = checknf(nf);
    1319      416075 :   if (typ(x) == t_MAT)
    1320             :   { /* factorisation */
    1321      101994 :     GEN g = gel(x,1), e = gel(x,2);
    1322      101994 :     V = zero_zv(n);
    1323      313192 :     for (i=1; i<lg(g); i++)
    1324      211198 :       if (mpodd(gel(e,i)))
    1325      170405 :         Flv_add_inplace(V, nfsign_arch(nf,gel(g,i),archp), 2);
    1326      101994 :     avma = (pari_sp)V; return V;
    1327             :   }
    1328      314081 :   av = avma; V = cgetg(n+1,t_VECSMALL);
    1329      314081 :   x = nf_to_scalar_or_basis(nf, x);
    1330      314081 :   switch(typ(x))
    1331             :   {
    1332             :     case t_INT:
    1333       78081 :       s = signe(x);
    1334       78081 :       if (!s) pari_err_DOMAIN("nfsign_arch","element","=",gen_0,x);
    1335       78081 :       avma = av; return const_vecsmall(n, (s < 0)? 1: 0);
    1336             :     case t_FRAC:
    1337         441 :       s = signe(gel(x,1));
    1338         441 :       avma = av; return const_vecsmall(n, (s < 0)? 1: 0);
    1339             :   }
    1340      235559 :   x = Q_primpart(x); M = nf_get_M(nf);
    1341      235559 :   for (i = 1; i <= n; i++) V[i] = (eval_sign(M, x, archp[i]) < 0)? 1: 0;
    1342      235559 :   avma = (pari_sp)V; return V;
    1343             : }
    1344             : 
    1345             : /* return the vector of signs of x; the matrix of such if x is a vector
    1346             :  * of nf elements */
    1347             : GEN
    1348         378 : nfsign(GEN nf, GEN x)
    1349             : {
    1350             :   long i, l;
    1351             :   GEN archp, S;
    1352             : 
    1353         378 :   nf = checknf(nf);
    1354         378 :   archp = identity_perm( nf_get_r1(nf) );
    1355         378 :   if (typ(x) != t_VEC) return nfsign_arch(nf, x, archp);
    1356          70 :   l = lg(x); S = cgetg(l, t_MAT);
    1357          70 :   for (i=1; i<l; i++) gel(S,i) = nfsign_arch(nf, gel(x,i), archp);
    1358          70 :   return S;
    1359             : }
    1360             : 
    1361             : /* multiply y by t = 1 mod^* f such that sign(x) = sign(y) at arch = divisor[2].
    1362             :  * If x == NULL, make y >> 0 at sarch */
    1363             : GEN
    1364       87444 : set_sign_mod_divisor(GEN nf, GEN x, GEN y, GEN sarch)
    1365             : {
    1366             :   GEN s, archp, gen;
    1367             :   long nba,i;
    1368       87444 :   if (!sarch) return y;
    1369       87444 :   gen = gel(sarch,2); nba = lg(gen);
    1370       87444 :   if (nba == 1) return y;
    1371             : 
    1372       72828 :   archp = gel(sarch,4);
    1373       72828 :   y = nf_to_scalar_or_basis(nf, y);
    1374       72828 :   s = nfsign_arch(nf, y, archp);
    1375       72828 :   if (x) Flv_add_inplace(s, nfsign_arch(nf, x, archp), 2);
    1376       72828 :   s = Flm_Flc_mul(gel(sarch,3), s, 2);
    1377      170653 :   for (i=1; i<nba; i++)
    1378       97825 :     if (s[i]) y = nfmul(nf,y,gel(gen,i));
    1379       72828 :   return y;
    1380             : }
    1381             : 
    1382             : /* x integral elt, A integral ideal in HNF; reduce x mod A */
    1383             : static GEN
    1384      572131 : zk_modHNF(GEN x, GEN A)
    1385      572131 : { return (typ(x) == t_COL)?  ZC_hnfrem(x, A): modii(x, gcoeff(A,1,1)); }
    1386             : 
    1387             : /* given an element x in Z_K and an integral ideal y in HNF, coprime with x,
    1388             :    outputs an element inverse of x modulo y */
    1389             : GEN
    1390         364 : nfinvmodideal(GEN nf, GEN x, GEN y)
    1391             : {
    1392         364 :   pari_sp av = avma;
    1393         364 :   GEN a, yZ = gcoeff(y,1,1);
    1394             : 
    1395         364 :   if (is_pm1(yZ)) return gen_0;
    1396         364 :   x = nf_to_scalar_or_basis(nf, x);
    1397         364 :   if (typ(x) == t_INT) return gerepileupto(av, Fp_inv(x, yZ));
    1398             : 
    1399         217 :   a = hnfmerge_get_1(idealhnf_principal(nf,x), y);
    1400         217 :   if (!a) pari_err_INV("nfinvmodideal", x);
    1401         217 :   return gerepileupto(av, zk_modHNF(nfdiv(nf,a,x), y));
    1402             : }
    1403             : 
    1404             : static GEN
    1405      282307 : nfsqrmodideal(GEN nf, GEN x, GEN id)
    1406      282307 : { return zk_modHNF(nfsqri(nf,x), id); }
    1407             : static GEN
    1408      603249 : nfmulmodideal(GEN nf, GEN x, GEN y, GEN id)
    1409      603249 : { return x? zk_modHNF(nfmuli(nf,x,y), id): y; }
    1410             : /* assume x integral, k integer, A in HNF */
    1411             : GEN
    1412      386695 : nfpowmodideal(GEN nf,GEN x,GEN k,GEN A)
    1413             : {
    1414      386695 :   long s = signe(k);
    1415             :   pari_sp av;
    1416             :   GEN y;
    1417             : 
    1418      386695 :   if (!s) return gen_1;
    1419      386695 :   av = avma;
    1420      386695 :   x = nf_to_scalar_or_basis(nf, x);
    1421      386695 :   if (typ(x) != t_COL) return Fp_pow(x, k, gcoeff(A,1,1));
    1422      200449 :   if (s < 0) { x = nfinvmodideal(nf, x,A); k = absi(k); }
    1423      200449 :   for(y = NULL;;)
    1424             :   {
    1425      482756 :     if (mpodd(k)) y = nfmulmodideal(nf,y,x,A);
    1426      482756 :     k = shifti(k,-1); if (!signe(k)) break;
    1427      282307 :     x = nfsqrmodideal(nf,x,A);
    1428      282307 :   }
    1429      200449 :   return gerepileupto(av, y);
    1430             : }
    1431             : 
    1432             : /* a * g^n mod id */
    1433             : static GEN
    1434      326635 : elt_mulpow_modideal(GEN nf, GEN a, GEN g, GEN n, GEN id)
    1435             : {
    1436      326635 :   return nfmulmodideal(nf, a, nfpowmodideal(nf,g,n,id), id);
    1437             : }
    1438             : 
    1439             : /* assume (num(g[i]), id) = 1 for all i. Return prod g[i]^e[i] mod id.
    1440             :  * EX = multiple of exponent of (O_K/id)^* */
    1441             : GEN
    1442      113193 : famat_to_nf_modideal_coprime(GEN nf, GEN g, GEN e, GEN id, GEN EX)
    1443             : {
    1444      113193 :   GEN EXo2, plus = NULL, minus = NULL, idZ = gcoeff(id,1,1);
    1445      113193 :   long i, lx = lg(g);
    1446             : 
    1447      113193 :   if (is_pm1(idZ)) return gen_1; /* id = Z_K */
    1448      113102 :   EXo2 = (expi(EX) > 10)? shifti(EX,-1): NULL;
    1449      456585 :   for (i = 1; i < lx; i++)
    1450             :   {
    1451      343483 :     GEN h, n = centermodii(gel(e,i), EX, EXo2);
    1452      343483 :     long sn = signe(n);
    1453      343483 :     if (!sn) continue;
    1454             : 
    1455      246529 :     h = nf_to_scalar_or_basis(nf, gel(g,i));
    1456      246529 :     switch(typ(h))
    1457             :     {
    1458      160748 :       case t_INT: break;
    1459             :       case t_FRAC:
    1460           0 :         h = Fp_div(gel(h,1), gel(h,2), idZ); break;
    1461             :       default:
    1462             :       {
    1463             :         GEN dh;
    1464       85781 :         h = Q_remove_denom(h, &dh);
    1465       85781 :         if (dh) h = FpC_Fp_mul(h, Fp_inv(dh,idZ), idZ);
    1466             :       }
    1467             :     }
    1468      246529 :     if (sn > 0)
    1469      245003 :       plus = elt_mulpow_modideal(nf, plus, h, n, id);
    1470             :     else /* sn < 0 */
    1471        1526 :       minus = elt_mulpow_modideal(nf, minus, h, absi(n), id);
    1472             :   }
    1473      113102 :   if (minus) plus = nfmulmodideal(nf, plus, nfinvmodideal(nf,minus,id), id);
    1474      113102 :   return plus? plus: gen_1;
    1475             : }
    1476             : 
    1477             : /* given 2 integral ideals x, y in HNF s.t x | y | x^2, compute the quotient
    1478             :    (1+x)/(1+y) in the form [[cyc],[gen]], if U != NULL, set *U := ux^-1 */
    1479             : static GEN
    1480       13482 : zidealij(GEN x, GEN y, GEN *U)
    1481             : {
    1482             :   GEN G, cyc;
    1483             :   long j, N;
    1484             : 
    1485             :   /* x^(-1) y = relations between the 1 + x_i (HNF) */
    1486       13482 :   cyc = ZM_snf_group(hnf_solve(x, y), U, &G);
    1487       13482 :   N = lg(cyc); G = ZM_mul(x,G); settyp(G, t_VEC); /* new generators */
    1488       61747 :   for (j=1; j<N; j++)
    1489             :   {
    1490       48265 :     GEN c = gel(G,j);
    1491       48265 :     gel(c,1) = addiu(gel(c,1), 1); /* 1 + g_j */
    1492       48265 :     if (ZV_isscalar(c)) gel(G,j) = gel(c,1);
    1493             :   }
    1494       13482 :   if (U) *U = RgM_mul(*U, RgM_inv(x));
    1495       13482 :   return mkvec2(cyc, G);
    1496             : }
    1497             : 
    1498             : static GEN
    1499      300743 : Fq_FpXQ_log(GEN a, GEN g, GEN ord, GEN T, GEN p)
    1500             : {
    1501      300743 :   if (!T) return Fp_log(a,g,ord,p);
    1502      121105 :   if (typ(a)==t_INT) return Fp_FpXQ_log(a,g,ord,T,p);
    1503       83640 :   return FpXQ_log(a,g,ord,T,p);
    1504             : }
    1505             : /* same in nf.zk / pr */
    1506             : static GEN
    1507      300743 : nf_log(GEN nf, GEN a, GEN g, GEN ord, GEN pr)
    1508             : {
    1509      300743 :   pari_sp av = avma;
    1510      300743 :   GEN T,p, modpr = nf_to_Fq_init(nf, &pr, &T, &p);
    1511      300743 :   GEN A = nf_to_Fq(nf,a,modpr);
    1512      300743 :   GEN G = nf_to_Fq(nf,g,modpr);
    1513      300743 :   return gerepileuptoint(av, Fq_FpXQ_log(A,G,ord,T,p));
    1514             : }
    1515             : 
    1516             : /* lg(x) > 1, x + 1; shallow */
    1517             : static GEN
    1518        3640 : ZC_add1(GEN x)
    1519             : {
    1520        3640 :   long i, l = lg(x);
    1521        3640 :   GEN y = cgetg(l, t_COL);
    1522        3640 :   for (i = 2; i < l; i++) gel(y,i) = gel(x,i);
    1523        3640 :   gel(y,1) = addiu(gel(x,1), 1); return y;
    1524             : }
    1525             : /* lg(x) > 1, x - 1; shallow */
    1526             : static GEN
    1527        1631 : ZC_sub1(GEN x)
    1528             : {
    1529        1631 :   long i, l = lg(x);
    1530        1631 :   GEN y = cgetg(l, t_COL);
    1531        1631 :   for (i = 2; i < l; i++) gel(y,i) = gel(x,i);
    1532        1631 :   gel(y,1) = subiu(gel(x,1), 1); return y;
    1533             : }
    1534             : 
    1535             : /* x,y are t_INT or ZC */
    1536             : static GEN
    1537           0 : zkadd(GEN x, GEN y)
    1538             : {
    1539           0 :   long tx = typ(x);
    1540           0 :   if (tx == typ(y))
    1541           0 :     return tx == t_INT? addii(x,y): ZC_add(x,y);
    1542             :   else
    1543           0 :     return tx == t_INT? ZC_Z_add(y,x): ZC_Z_add(x,y);
    1544             : }
    1545             : /* x a t_INT or ZC, x+1; shallow */
    1546             : static GEN
    1547        4410 : zkadd1(GEN x)
    1548             : {
    1549        4410 :   long tx = typ(x);
    1550        4410 :   return tx == t_INT? addiu(x,1): ZC_add1(x);
    1551             : }
    1552             : /* x a t_INT or ZC, x-1; shallow */
    1553             : static GEN
    1554        4410 : zksub1(GEN x)
    1555             : {
    1556        4410 :   long tx = typ(x);
    1557        4410 :   return tx == t_INT? subiu(x,1): ZC_sub1(x);
    1558             : }
    1559             : /* x,y are t_INT or ZC; x - y */
    1560             : static GEN
    1561           0 : zksub(GEN x, GEN y)
    1562             : {
    1563           0 :   long tx = typ(x), ty = typ(y);
    1564           0 :   if (tx == ty)
    1565           0 :     return tx == t_INT? subii(x,y): ZC_sub(x,y);
    1566             :   else
    1567           0 :     return tx == t_INT? Z_ZC_sub(x,y): ZC_Z_sub(x,y);
    1568             : }
    1569             : /* x is t_INT or ZM (mult. map), y is t_INT or ZC; x * y */
    1570             : static GEN
    1571        4410 : zkmul(GEN x, GEN y)
    1572             : {
    1573        4410 :   long tx = typ(x), ty = typ(y);
    1574        4410 :   if (ty == t_INT)
    1575        2779 :     return tx == t_INT? mulii(x,y): ZC_Z_mul(gel(x,1),y);
    1576             :   else
    1577        1631 :     return tx == t_INT? ZC_Z_mul(y,x): ZM_ZC_mul(x,y);
    1578             : }
    1579             : 
    1580             : /* (U,V) = 1 coprime ideals. Want z = x mod U, = y mod V; namely
    1581             :  * z =vx + uy = v(x-y) + y, where u + v = 1, u in U, v in V.
    1582             :  * zkc = [v, UV], v a t_INT or ZM (mult. by v map), UV a ZM (ideal in HNF);
    1583             :  * shallow */
    1584             : GEN
    1585           0 : zkchinese(GEN zkc, GEN x, GEN y)
    1586             : {
    1587           0 :   GEN v = gel(zkc,1), UV = gel(zkc,2), z = zkadd(zkmul(v, zksub(x,y)), y);
    1588           0 :   return zk_modHNF(z, UV);
    1589             : }
    1590             : /* special case z = x mod U, = 1 mod V; shallow */
    1591             : GEN
    1592        4410 : zkchinese1(GEN zkc, GEN x)
    1593             : {
    1594        4410 :   GEN v = gel(zkc,1), UV = gel(zkc,2), z = zkadd1(zkmul(v, zksub1(x)));
    1595        4410 :   return (typ(z) == t_INT)? z: ZC_hnfrem(z, UV);
    1596             : }
    1597             : static GEN
    1598         518 : zkVchinese1(GEN zkc, GEN v)
    1599             : {
    1600             :   long i, ly;
    1601         518 :   GEN y = cgetg_copy(v, &ly);
    1602         518 :   for (i=1; i<ly; i++) gel(y,i) = zkchinese1(zkc, gel(v,i));
    1603         518 :   return y;
    1604             : }
    1605             : 
    1606             : /* prepare to solve z = x (mod A), z = y mod (B) [zkchinese or zkchinese1] */
    1607             : GEN
    1608        2646 : zkchineseinit(GEN nf, GEN A, GEN B, GEN AB)
    1609             : {
    1610             :   GEN v;
    1611        2646 :   nf = checknf(nf);
    1612        2646 :   v = idealaddtoone_i(nf, A, B);
    1613        2646 :   return mkvec2(zk_scalar_or_multable(nf,v), AB);
    1614             : }
    1615             : /* prepare to solve z = x (mod A), z = 1 mod (B)
    1616             :  * and then         z = 1 (mod A), z = y mod (B) [zkchinese1 twice] */
    1617             : static GEN
    1618         259 : zkchinese1init2(GEN nf, GEN A, GEN B, GEN AB)
    1619             : {
    1620         259 :   GEN zkc = zkchineseinit(nf, A, B, AB);
    1621         259 :   GEN mv = gel(zkc,1), mu;
    1622         259 :   if (typ(mv) == t_INT) return mkvec2(zkc, mkvec2(subui(1,mv),AB));
    1623         238 :   mu = RgM_Rg_add_shallow(ZM_neg(mv), gen_1);
    1624         238 :   return mkvec2(mkvec2(mv,AB), mkvec2(mu,AB));
    1625             : }
    1626             : 
    1627             : /* Given an ideal pr^ep, and an integral ideal x (in HNF form) compute a list
    1628             :  * of vectors,corresponding to the abelian groups (O_K/pr)^*, and
    1629             :  * 1 + pr^i/ 1 + pr^min(2i, ep), i = 1,...
    1630             :  * Each vector has 5 components as follows :
    1631             :  * [[cyc],[g],[g'],[sign],U.X^-1].
    1632             :  * cyc   = type as abelian group
    1633             :  * g, g' = generators. (g',x) = 1, not necessarily so for g
    1634             :  * sign  = vector of the sign(g') at arch.
    1635             :  * If x = NULL, the original ideal was a prime power */
    1636             : static GEN
    1637       13181 : zprimestar(GEN nf, GEN pr, GEN ep, GEN x, GEN arch)
    1638             : {
    1639       13181 :   pari_sp av = avma;
    1640       13181 :   long a, e = itos(ep), f = pr_get_f(pr);
    1641       13181 :   GEN p = pr_get_p(pr), list, g, g0, y, uv, prb, pre;
    1642             :   ulong mask;
    1643             : 
    1644       13181 :   if(DEBUGLEVEL>3) err_printf("treating pr^%ld, pr = %Ps\n",e,pr);
    1645       13181 :   if (f == 1)
    1646        6440 :     g = pgener_Fp(p);
    1647             :   else
    1648             :   {
    1649        6741 :     GEN T, modpr = zk_to_Fq_init(nf, &pr, &T, &p);
    1650        6741 :     g = Fq_to_nf(gener_FpXQ(T,p,NULL), modpr);
    1651        6741 :     g = poltobasis(nf, g);
    1652             :   }
    1653             :   /* g generates  (Z_K / pr)^* */
    1654       13181 :   prb = idealhnf_two(nf,pr);
    1655       13181 :   pre = (e==1)? prb: idealpow(nf,pr,ep);
    1656       13181 :   if (x)
    1657             :   {
    1658        2387 :     uv = zkchineseinit(nf, idealdivpowprime(nf,x,pr,ep), pre, x);
    1659        2387 :     g0 = zkchinese1(uv, g);
    1660             :   }
    1661             :   else
    1662             :   {
    1663       10794 :     uv = NULL; /* gcc -Wall */
    1664       10794 :     g0 = g;
    1665             :   }
    1666             : 
    1667       13181 :   y = mkvec5(mkvec(subiu(powiu(p,f), 1)),
    1668             :              mkvec(g),
    1669             :              mkvec(g0),
    1670             :              mkvec(nfsign_arch(nf,g0,arch)),
    1671             :              gen_1);
    1672       13181 :   if (e == 1) return gerepilecopy(av, mkvec(y));
    1673        7840 :   list = vectrunc_init(e+1);
    1674        7840 :   vectrunc_append(list, y);
    1675        7840 :   mask = quadratic_prec_mask(e);
    1676        7840 :   a = 1;
    1677       27601 :   while (mask > 1)
    1678             :   {
    1679       11921 :     GEN pra = prb, gen, z, s, U;
    1680       11921 :     long i, l, b = a << 1;
    1681             : 
    1682       11921 :     if (mask & 1) b--;
    1683       11921 :     mask >>= 1;
    1684             :     /* compute 1 + pr^a / 1 + pr^b, 2a <= b */
    1685       11921 :     if(DEBUGLEVEL>3) err_printf("  treating a = %ld, b = %ld\n",a,b);
    1686       11921 :     prb = (b >= e)? pre: idealpows(nf,pr,b);
    1687       11921 :     z = zidealij(pra, prb, &U);
    1688       11921 :     gen = leafcopy(gel(z,2));
    1689       11921 :     s = cgetg_copy(gen, &l);
    1690       58156 :     for (i = 1; i < l; i++)
    1691             :     {
    1692       46235 :       if (x) gel(gen,i) = zkchinese1(uv, gel(gen,i));
    1693       46235 :       gel(s,i) = nfsign_arch(nf, gel(gen,i), arch);
    1694             :     }
    1695       11921 :     y = mkvec5(gel(z,1), gel(z,2), gen, s, U);
    1696       11921 :     vectrunc_append(list, y);
    1697       11921 :     a = b;
    1698             :   }
    1699        7840 :   return gerepilecopy(av, list);
    1700             : }
    1701             : 
    1702             : static GEN
    1703      223381 : apply_U(GEN U, GEN a)
    1704             : {
    1705             :   GEN e;
    1706      223381 :   if (typ(a) == t_INT)
    1707       93724 :     e = RgC_Rg_mul(gel(U,1), subis(a, 1));
    1708             :   else
    1709             :   { /* t_COL */
    1710      129657 :     GEN t = gel(a,1);
    1711      129657 :     gel(a,1) = addsi(-1, gel(a,1)); /* a -= 1 */
    1712      129657 :     e = RgM_RgC_mul(U, a);
    1713      129657 :     gel(a,1) = t; /* restore */
    1714             :   }
    1715      223381 :   return e;
    1716             : }
    1717             : /* a in Z_K (t_COL or t_INT), pr prime ideal, prk = pr^k,
    1718             :  * list = zprimestar(nf, pr, k, ...)  */
    1719             : static GEN
    1720      300743 : zlog_pk(GEN nf, GEN a, GEN y, GEN pr, GEN prk, GEN list, GEN *psigne)
    1721             : {
    1722      300743 :   long i,j, llist = lg(list)-1;
    1723      823698 :   for (j = 1; j <= llist; j++)
    1724             :   {
    1725      522962 :     GEN L = gel(list,j), e;
    1726      522962 :     GEN cyc = gel(L,1), gen = gel(L,2), s = gel(L,4), U = gel(L,5);
    1727      522962 :     if (j == 1)
    1728      300743 :       e = mkcol( nf_log(nf, a, gel(gen,1), gel(cyc,1), pr) );
    1729             :     else
    1730      222219 :       e = apply_U(U, a);
    1731             :     /* here lg(e) == lg(cyc) */
    1732     1595197 :     for (i = 1; i < lg(cyc); i++)
    1733             :     {
    1734             :       GEN t;
    1735     1072242 :       if (typ(gel(e,i)) != t_INT) pari_err_COPRIME("zlog_pk", a, pr);
    1736     1072235 :       t = modii(negi(gel(e,i)), gel(cyc,i));
    1737     1072235 :       gel(++y,0) = negi(t); if (!signe(t)) continue;
    1738             : 
    1739      337796 :       if (mod2(t)) Flv_add_inplace(*psigne, gel(s,i), 2);
    1740      337796 :       if (j != llist) a = elt_mulpow_modideal(nf, a, gel(gen,i), t, prk);
    1741             :     }
    1742             :   }
    1743      300736 :   return y;
    1744             : }
    1745             : 
    1746             : static void
    1747      289186 : zlog_add_sign(GEN y0, GEN sgn, GEN sarch)
    1748             : {
    1749             :   GEN y, s;
    1750             :   long i;
    1751      578372 :   if (!sgn) return;
    1752      289186 :   y = y0 + lg(y0);
    1753      289186 :   s = Flm_Flc_mul(gel(sarch,3), sgn, 2);
    1754      289186 :   for (i = lg(s)-1; i > 0; i--) gel(--y,0) = s[i]? gen_1: gen_0;
    1755             : }
    1756             : 
    1757             : static GEN
    1758       95697 : famat_zlog(GEN nf, GEN fa, GEN sgn, GEN bid)
    1759             : {
    1760       95697 :   GEN g = gel(fa,1), e = gel(fa,2);
    1761       95697 :   GEN vp = gmael(bid, 3,1), ep = gmael(bid, 3,2);
    1762       95697 :   GEN arch = bid_get_arch(bid);
    1763       95697 :   GEN cyc = bid_get_cyc(bid), sprk = bid_get_sprk(bid), U = bid_get_U(bid);
    1764       95697 :   GEN y0, x, y, EX = gel(cyc,1);
    1765             :   long i, l;
    1766             : 
    1767       95697 :   y0 = y = cgetg(lg(U), t_COL);
    1768       95697 :   if (!sgn) sgn = nfsign_arch(nf, mkmat2(g,e), arch);
    1769       95697 :   l = lg(vp);
    1770      190186 :   for (i=1; i < l; i++)
    1771             :   {
    1772       94489 :     GEN pr = gel(vp,i), prk, ex;
    1773       94489 :     if (l == 2) {
    1774       67323 :       prk = bid_get_ideal(bid);
    1775       67323 :       ex = EX;
    1776             :     } else { /* try to improve EX: should be group exponent mod prf, not f */
    1777       27166 :       GEN k = gel(ep,i);
    1778       27166 :       prk = idealpow(nf, pr, k);
    1779             :       /* upper bound: gcd(EX, (Nv-1)p^(k-1)) = (Nv-1) p^min(k-1,v_p(EX)) */
    1780       27166 :       ex = subis(pr_norm(pr),1);
    1781       27166 :       if (!is_pm1(k)) {
    1782        3563 :         GEN p = pr_get_p(pr), k_1 = subis(k,1);
    1783        3563 :         long v = Z_pval(EX, p);
    1784        3563 :         if (abscmpui(v, k_1) > 0) v = itos(k_1);
    1785        3563 :         if (v) ex = mulii(ex, powiu(p, v));
    1786             :       }
    1787             :     }
    1788       94489 :     x = famat_makecoprime(nf, g, e, pr, prk, ex);
    1789       94489 :     y = zlog_pk(nf, x, y, pr, prk, gel(sprk,i), &sgn);
    1790             :   }
    1791       95697 :   zlog_add_sign(y0, sgn, bid_get_sarch(bid));
    1792       95697 :   return y0;
    1793             : }
    1794             : 
    1795             : static GEN
    1796       13734 : get_index(GEN sprk)
    1797             : {
    1798       13734 :   long t = 0, k, l = lg(sprk);
    1799       13734 :   GEN ind = cgetg(l, t_VECSMALL);
    1800       27496 :   for (k = 1; k < l; k++)
    1801             :   {
    1802       13762 :     GEN L = gel(sprk,k);
    1803       13762 :     long j, lL = lg(L);
    1804       13762 :     ind[k] = t;
    1805       13762 :     for (j=1; j<lL; j++) t += lg(gmael(L,j,1)) - 1;
    1806             :   }
    1807       13734 :   return ind;
    1808             : }
    1809             : 
    1810             : static void
    1811      130818 : init_zlog(zlog_S *S, long n, GEN P, GEN e, GEN sprk, GEN sarch, GEN ind, GEN U)
    1812             : {
    1813      130818 :   S->n = n;
    1814      130818 :   S->U = U;
    1815      130818 :   S->P = P;
    1816      130818 :   S->e = e;
    1817      130818 :   S->archp = gel(sarch,4);
    1818      130818 :   S->sprk = sprk;
    1819      130818 :   S->sarch = sarch;
    1820      130818 :   S->ind = ind;
    1821      130818 : }
    1822             : void
    1823      118981 : init_zlog_bid(zlog_S *S, GEN bid)
    1824             : {
    1825      118981 :   GEN fa = bid_get_fact(bid), sprk = bid_get_sprk(bid), U = bid_get_U(bid);
    1826      118981 :   GEN sarch = bid_get_sarch(bid), ind = bid_get_ind(bid);
    1827      118981 :   init_zlog(S, lg(U)-1, gel(fa,1), gel(fa,2), sprk, sarch, ind, U);
    1828      118981 : }
    1829             : 
    1830             : /* Return decomposition of a on the S->n successive generators contained in
    1831             :  * S->sprk and S->sarch. If index !=0, do the computation for the
    1832             :  * corresponding prime ideal and set to 0 the other components. */
    1833             : static GEN
    1834      176563 : zlog_ind(GEN nf, GEN a, zlog_S *S, GEN sgn, long index)
    1835             : {
    1836      176563 :   GEN y0 = zerocol(S->n), y;
    1837      176563 :   pari_sp av = avma;
    1838             :   long k, kmin, kmax;
    1839             : 
    1840      176563 :   a = nf_to_scalar_or_basis(nf,a);
    1841      176563 :   if (index)
    1842             :   {
    1843       59416 :     kmin = kmax = index;
    1844       59416 :     y = y0 + S->ind[index];
    1845             :   }
    1846             :   else
    1847             :   {
    1848      117147 :     kmin = 1; kmax = lg(S->P)-1;
    1849      117147 :     y = y0;
    1850             :   }
    1851      176563 :   if (!sgn) sgn = nfsign_arch(nf, a, S->archp);
    1852      378988 :   for (k = kmin; k <= kmax; k++)
    1853             :   {
    1854      202432 :     GEN L = gel(S->sprk,k), pr  = gel(S->P,k);
    1855      202432 :     GEN prk = idealpow(nf, pr, gel(S->e,k));
    1856      202432 :     y = zlog_pk(nf, a, y, pr, prk, L, &sgn);
    1857             :   }
    1858      176556 :   zlog_add_sign(y0, sgn, S->sarch);
    1859      176556 :   return gerepilecopy(av, y0);
    1860             : }
    1861             : /* sgn = sign(a, S->arch) or NULL if unknown */
    1862             : GEN
    1863      117147 : zlog(GEN nf, GEN a, GEN sgn, zlog_S *S) { return zlog_ind(nf, a, S, sgn, 0); }
    1864             : 
    1865             : /* Log on bid.gen of generators of P_{1,I pr^{e-1}} / P_{1,I pr^e} (I,pr) = 1,
    1866             :  * defined implicitly via CRT. 'index' is the index of pr in modulus
    1867             :  * factorization */
    1868             : GEN
    1869        9989 : log_gen_pr(zlog_S *S, long index, GEN nf, long e)
    1870             : {
    1871        9989 :   long i, l, yind = S->ind[index];
    1872        9989 :   GEN y, A, L, L2 = gel(S->sprk,index);
    1873             : 
    1874        9989 :   if (e == 1)
    1875             :   {
    1876        6839 :     L = gel(L2,1);
    1877        6839 :     y = col_ei(S->n, yind+1);
    1878        6839 :     zlog_add_sign(y, gmael(L,4,1), S->sarch);
    1879        6839 :     retmkmat( ZM_ZC_mul(S->U, y) );
    1880             :   }
    1881             :   else
    1882             :   {
    1883        3150 :     GEN prk, g, pr = gel(S->P,index);
    1884        3150 :     long narchp = lg(S->archp)-1;
    1885             : 
    1886        3150 :     if (e == 2)
    1887        1960 :       L = gel(L2,2);
    1888             :     else
    1889        1190 :       L = zidealij(idealpows(nf,pr,e-1), idealpows(nf,pr,e), NULL);
    1890        3150 :     g = gel(L,2);
    1891        3150 :     l = lg(g); A = cgetg(l, t_MAT);
    1892        3150 :     prk = idealpow(nf, pr, gel(S->e,index));
    1893        6972 :     for (i = 1; i < l; i++)
    1894             :     {
    1895        3822 :       GEN G = gel(g,i), sgn = zero_zv(narchp); /*positive at f_oo*/
    1896        3822 :       y = zerocol(S->n);
    1897        3822 :       (void)zlog_pk(nf, G, y + yind, pr, prk, L2, &sgn);
    1898        3822 :       zlog_add_sign(y, sgn, S->sarch);
    1899        3822 :       gel(A,i) = y;
    1900             :     }
    1901        3150 :     return ZM_mul(S->U, A);
    1902             :   }
    1903             : }
    1904             : /* Log on bid.gen of generator of P_{1,f} / P_{1,f v[index]}
    1905             :  * v = vector of r1 real places */
    1906             : GEN
    1907        6272 : log_gen_arch(zlog_S *S, long index)
    1908             : {
    1909        6272 :   GEN y = zerocol(S->n);
    1910        6272 :   zlog_add_sign(y, vecsmall_ei(lg(S->archp)-1, index), S->sarch);
    1911        6272 :   return ZM_ZC_mul(S->U, y);
    1912             : }
    1913             : 
    1914             : /* add [h,cyc] or [h,cyc,gen] to bid */
    1915             : static void
    1916       13734 : add_grp(GEN nf, GEN u1, GEN cyc, GEN gen, GEN bid)
    1917             : {
    1918       13734 :   GEN h = ZV_prod(cyc);
    1919       13734 :   if (u1)
    1920             :   {
    1921        7497 :     GEN G = mkvec3(h,cyc,NULL/*dummy, bid[2] needed below*/);
    1922        7497 :     gel(bid,2) = G;
    1923        7497 :     if (u1 != gen_1)
    1924             :     {
    1925        5971 :       long i, c = lg(u1);
    1926        5971 :       GEN g = cgetg(c,t_VEC);
    1927       18557 :       for (i=1; i<c; i++)
    1928       12586 :         gel(g,i) = famat_to_nf_moddivisor(nf, gen, gel(u1,i), bid);
    1929        5971 :       gen = g;
    1930             :     }
    1931        7497 :     gel(G,3) = gen; /* replace dummy */
    1932             :   }
    1933             :   else
    1934        6237 :     gel(bid,2) = mkvec2(h,cyc);
    1935       13734 : }
    1936             : 
    1937             : /* Compute [[ideal,arch], [h,[cyc],[gen]], idealfact, [liste], U]
    1938             :    flag may include nf_GEN | nf_INIT */
    1939             : static GEN
    1940       13440 : Idealstar_i(GEN nf, GEN ideal, long flag)
    1941             : {
    1942             :   long i, j, k, nbp, R1, nbgen;
    1943       13440 :   GEN t, y, cyc, U, u1 = NULL, fa, sprk, x, arch, archp, E, P, sarch, gen, ind;
    1944             : 
    1945       13440 :   nf = checknf(nf);
    1946       13440 :   R1 = nf_get_r1(nf);
    1947       13440 :   if (typ(ideal) == t_VEC && lg(ideal) == 3)
    1948             :   {
    1949        5376 :     arch = gel(ideal,2);
    1950        5376 :     ideal= gel(ideal,1);
    1951        5376 :     switch(typ(arch))
    1952             :     {
    1953             :       case t_VEC:
    1954        5341 :         if (lg(arch) != R1+1)
    1955           0 :           pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
    1956        5341 :         archp = vec01_to_indices(arch);
    1957        5341 :         break;
    1958             :       case t_VECSMALL:
    1959          35 :         archp = arch;
    1960          35 :         k = lg(archp)-1;
    1961          35 :         if (k && archp[k] > R1)
    1962           7 :           pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
    1963          28 :         arch = indices_to_vec01(archp, R1);
    1964          28 :         break;
    1965             :       default:
    1966           0 :         pari_err_TYPE("Idealstar [incorrect archimedean component]",arch);
    1967           0 :         return NULL;
    1968             :     }
    1969        5369 :   }
    1970             :   else
    1971             :   {
    1972        8064 :     arch = zerovec(R1);
    1973        8064 :     archp = cgetg(1, t_VECSMALL);
    1974             :   }
    1975       13433 :   if (is_nf_factor(ideal))
    1976             :   {
    1977        6286 :     fa = ideal;
    1978        6286 :     x = idealfactorback(nf, gel(fa,1), gel(fa,2), 0);
    1979             :   }
    1980             :   else
    1981             :   {
    1982        7147 :     fa = NULL;
    1983        7147 :     x = idealhnf_shallow(nf, ideal);
    1984             :   }
    1985       13433 :   if (lg(x) == 1) pari_err_DOMAIN("Idealstar", "ideal","=",gen_0,x);
    1986       13426 :   if (typ(gcoeff(x,1,1)) != t_INT)
    1987           7 :     pari_err_DOMAIN("Idealstar","denominator(ideal)", "!=",gen_1,x);
    1988       13419 :   sarch = nfarchstar(nf, x, archp);
    1989       13419 :   if (!fa) fa = idealfactor(nf, ideal);
    1990       13419 :   P = gel(fa,1);
    1991       13419 :   E = gel(fa,2); nbp = lg(P)-1;
    1992       13419 :   sprk = cgetg(nbp+1,t_VEC);
    1993       13419 :   if (nbp)
    1994             :   {
    1995             :     GEN h;
    1996       11837 :     long cp = 0;
    1997             :     zlog_S S;
    1998             : 
    1999             :     /* rough upper bound */
    2000       11837 :     nbgen = nbp + 1; for (i=1; i<=nbp; i++) nbgen += itos(gel(E,i));
    2001       11837 :     gen = cgetg(nbgen+1,t_VEC);
    2002       11837 :     nbgen = 1;
    2003       11837 :     t = (nbp==1)? NULL: x;
    2004       25018 :     for (i=1; i<=nbp; i++)
    2005             :     {
    2006       13181 :       GEN L = zprimestar(nf, gel(P,i), gel(E,i), t, archp);
    2007       13181 :       gel(sprk,i) = L;
    2008       13181 :       for (j = 1; j < lg(L); j++) gel(gen, nbgen++) = gmael(L,j,3);
    2009             :     }
    2010       11837 :     gel(gen, nbgen++) = gel(sarch,2); setlg(gen, nbgen);
    2011       11837 :     gen = shallowconcat1(gen); nbgen = lg(gen)-1;
    2012             : 
    2013       11837 :     h = cgetg(nbgen+1,t_MAT);
    2014       11837 :     ind = get_index(sprk);
    2015       11837 :     init_zlog(&S, nbgen, P, E, sprk, sarch, ind, NULL);
    2016       25018 :     for (i=1; i<=nbp; i++)
    2017             :     {
    2018       13181 :       GEN L2 = gel(sprk,i);
    2019       38283 :       for (j=1; j < lg(L2); j++)
    2020             :       {
    2021       25102 :         GEN L = gel(L2,j), F = gel(L,1), G = gel(L,3);
    2022       84518 :         for (k=1; k<lg(G); k++)
    2023             :         { /* log(g^f) mod divisor */
    2024       59416 :           GEN g = gel(G,k), f = gel(F,k), a = nfpowmodideal(nf,g,f,x);
    2025      129997 :           GEN sgn = mpodd(f)? nfsign_arch(nf, g, S.archp)
    2026       70581 :                             : zero_zv(lg(S.archp)-1);
    2027       59416 :           gel(h,++cp) = ZC_neg(zlog_ind(nf, a, &S, sgn, i));
    2028       59416 :           gcoeff(h,cp,cp) = f;
    2029             :         }
    2030             :       }
    2031             :     }
    2032       16604 :     for (j=1; j<lg(archp); j++)
    2033             :     {
    2034        4767 :       gel(h,++cp) = zerocol(nbgen);
    2035        4767 :       gcoeff(h,cp,cp) = gen_2;
    2036             :     }
    2037             :     /* assert(cp == nbgen) */
    2038       11837 :     h = ZM_hnfall_i(h,NULL,0);
    2039       11837 :     cyc = ZM_snf_group(h, &U, (flag & nf_GEN)? &u1: NULL);
    2040             :   }
    2041             :   else
    2042             :   {
    2043        1582 :     ind = get_index(sprk);
    2044        1582 :     gen = gel(sarch,2); nbgen = lg(gen)-1;
    2045        1582 :     cyc = const_vec(nbgen, gen_2);
    2046        1582 :     U = matid(nbgen);
    2047        1582 :     if (flag & nf_GEN) u1 = gen_1;
    2048             :   }
    2049             : 
    2050       13419 :   y = cgetg(6,t_VEC);
    2051       13419 :   gel(y,1) = mkvec2(x, arch);
    2052       13419 :   gel(y,3) = fa;
    2053       13419 :   gel(y,4) = mkvec3(sprk, sarch, ind);
    2054       13419 :   gel(y,5) = U;
    2055       13419 :   add_grp(nf, u1, cyc, gen, y);
    2056       13419 :   return (flag & nf_INIT)? y: gel(y,2);
    2057             : }
    2058             : GEN
    2059        7553 : Idealstar(GEN nf, GEN ideal, long flag)
    2060             : {
    2061             :   pari_sp av;
    2062        7553 :   if (!nf) return ZNstar(ideal, flag);
    2063        7273 :   av = avma;
    2064        7273 :   return gerepilecopy(av, Idealstar_i(nf, ideal, flag));
    2065             : }
    2066             : GEN
    2067        6167 : Idealstarprk(GEN nf, GEN pr, long k, long flag)
    2068             : {
    2069        6167 :   pari_sp av = avma;
    2070        6167 :   GEN z = Idealstar_i(nf, mkmat2(mkcol(pr),mkcols(k)), flag);
    2071        6167 :   return gerepilecopy(av, z);
    2072             : }
    2073             : 
    2074             : /* vectors of [[cyc],[g],U.X^-1] */
    2075             : static GEN
    2076         238 : principal_units(GEN nf, GEN pr, long e, GEN pre)
    2077             : {
    2078         238 :   pari_sp av = avma;
    2079             :   long a;
    2080             :   GEN list, prb;
    2081             :   ulong mask;
    2082             : 
    2083         238 :   if(DEBUGLEVEL>3) err_printf("treating pr^%ld, pr = %Ps\n",e,pr);
    2084         238 :   if (e == 1) return cgetg(1, t_VEC);
    2085         238 :   prb = idealhnf_two(nf,pr);
    2086         238 :   list = vectrunc_init(e);
    2087         238 :   mask = quadratic_prec_mask(e);
    2088         238 :   a = 1;
    2089         847 :   while (mask > 1)
    2090             :   {
    2091         371 :     GEN pra = prb, z, U;
    2092         371 :     long b = a << 1;
    2093             : 
    2094         371 :     if (mask & 1) b--;
    2095         371 :     mask >>= 1;
    2096             :     /* compute 1 + pr^a / 1 + pr^b, 2a <= b */
    2097         371 :     if(DEBUGLEVEL>3) err_printf("  treating a = %ld, b = %ld\n",a,b);
    2098         371 :     prb = (b >= e)? pre: idealpows(nf,pr,b);
    2099         371 :     z = zidealij(pra, prb, &U);
    2100         371 :     vectrunc_append(list, mkvec3(gel(z,1),gel(z,2),U));
    2101         371 :     a = b;
    2102             :   }
    2103         238 :   return gerepilecopy(av, list);
    2104             : }
    2105             : 
    2106             : static GEN
    2107         630 : log_prk(GEN nf, GEN a, long nbgen, GEN list, GEN prk)
    2108             : {
    2109         630 :   GEN y = zerocol(nbgen);
    2110         630 :   long i,j, iy = 1, llist = lg(list)-1;
    2111             : 
    2112        1792 :   for (j = 1; j <= llist; j++)
    2113             :   {
    2114        1162 :     GEN L = gel(list,j);
    2115        1162 :     GEN cyc = gel(L,1), gen = gel(L,2), U = gel(L,3);
    2116        1162 :     GEN e = apply_U(U, a);
    2117             :     /* here lg(e) == lg(cyc) */
    2118        3906 :     for (i = 1; i < lg(cyc); i++)
    2119             :     {
    2120        2744 :       GEN t = modii(negi(gel(e,i)), gel(cyc,i));
    2121        2744 :       gel(y, iy++) = negi(t); if (!signe(t)) continue;
    2122         280 :       if (j != llist) a = elt_mulpow_modideal(nf, a, gel(gen,i), t, prk);
    2123             :     }
    2124             :   }
    2125         630 :   return y;
    2126             : }
    2127             : 
    2128             : /* multiplicative group (1 + pr) / (1 + pr^e) */
    2129             : GEN
    2130         238 : idealprincipalunits(GEN nf, GEN pr, long e)
    2131             : {
    2132         238 :   pari_sp av = avma;
    2133             :   long c, i, j, k, nbgen;
    2134         238 :   GEN cyc, u1 = NULL, pre, gen;
    2135             :   GEN g, EX, h, L2;
    2136         238 :   long cp = 0;
    2137             : 
    2138         238 :   nf = checknf(nf); pre = idealpows(nf, pr, e);
    2139         238 :   L2 = principal_units(nf, pr, e, pre);
    2140         238 :   c = lg(L2); gen = cgetg(c, t_VEC);
    2141         238 :   for (j = 1; j < c; j++) gel(gen, j) = gmael(L2,j,2);
    2142         238 :   gen = shallowconcat1(gen); nbgen = lg(gen)-1;
    2143             : 
    2144         238 :   h = cgetg(nbgen+1,t_MAT);
    2145         609 :   for (j=1; j < lg(L2); j++)
    2146             :   {
    2147         371 :     GEN L = gel(L2,j), F = gel(L,1), G = gel(L,2);
    2148        1001 :     for (k=1; k<lg(G); k++)
    2149             :     { /* log(g^f) mod pr^e */
    2150         630 :       GEN g = gel(G,k), f = gel(F,k), a = nfpowmodideal(nf,g,f,pre);
    2151         630 :       gel(h,++cp) = ZC_neg(log_prk(nf, a, nbgen, L2, pre));
    2152         630 :       gcoeff(h,cp,cp) = f;
    2153             :     }
    2154             :   }
    2155             :   /* assert(cp == nbgen) */
    2156         238 :   h = ZM_hnfall_i(h,NULL,0);
    2157         238 :   cyc = ZM_snf_group(h, NULL, &u1);
    2158         238 :   c = lg(u1); g = cgetg(c, t_VEC); EX = gel(cyc,1);
    2159         679 :   for (i=1; i<c; i++)
    2160         441 :     gel(g,i) = famat_to_nf_modideal_coprime(nf, gen, gel(u1,i), pre, EX);
    2161         238 :   return gerepilecopy(av, mkvec3(powiu(pr_norm(pr), e-1), cyc, g));
    2162             : }
    2163             : 
    2164             : /* FIXME: obsolete */
    2165             : GEN
    2166           0 : zidealstarinitgen(GEN nf, GEN ideal)
    2167           0 : { return Idealstar(nf,ideal, nf_INIT|nf_GEN); }
    2168             : GEN
    2169           0 : zidealstarinit(GEN nf, GEN ideal)
    2170           0 : { return Idealstar(nf,ideal, nf_INIT); }
    2171             : GEN
    2172           0 : zidealstar(GEN nf, GEN ideal)
    2173           0 : { return Idealstar(nf,ideal, nf_GEN); }
    2174             : 
    2175             : GEN
    2176         350 : idealstar0(GEN nf, GEN ideal,long flag)
    2177             : {
    2178         350 :   switch(flag)
    2179             :   {
    2180           0 :     case 0: return Idealstar(nf,ideal, nf_GEN);
    2181         315 :     case 1: return Idealstar(nf,ideal, nf_INIT);
    2182          35 :     case 2: return Idealstar(nf,ideal, nf_INIT|nf_GEN);
    2183           0 :     default: pari_err_FLAG("idealstar");
    2184             :   }
    2185           0 :   return NULL; /* not reached */
    2186             : }
    2187             : 
    2188             : void
    2189      143613 : check_nfelt(GEN x, GEN *den)
    2190             : {
    2191      143613 :   long l = lg(x), i;
    2192      143613 :   GEN t, d = NULL;
    2193      143613 :   if (typ(x) != t_COL) pari_err_TYPE("check_nfelt", x);
    2194      596704 :   for (i=1; i<l; i++)
    2195             :   {
    2196      453091 :     t = gel(x,i);
    2197      453091 :     switch (typ(t))
    2198             :     {
    2199      351078 :       case t_INT: break;
    2200             :       case t_FRAC:
    2201      102013 :         if (!d) d = gel(t,2); else d = lcmii(d, gel(t,2));
    2202      102013 :         break;
    2203           0 :       default: pari_err_TYPE("check_nfelt", x);
    2204             :     }
    2205             :   }
    2206      143613 :   *den = d;
    2207      143613 : }
    2208             : 
    2209             : GEN
    2210      415398 : vecmodii(GEN a, GEN b)
    2211             : {
    2212             :   long i, l;
    2213      415398 :   GEN c = cgetg_copy(a, &l);
    2214      415398 :   for (i = 1; i < l; i++) gel(c,i) = modii(gel(a,i), gel(b,i));
    2215      415398 :   return c;
    2216             : }
    2217             : 
    2218             : /* Given x (not necessarily integral), and bid as output by zidealstarinit,
    2219             :  * compute the vector of components on the generators bid[2].
    2220             :  * Assume (x,bid) = 1 and sgn is either NULL or nfsign_arch(x, bid) */
    2221             : GEN
    2222      200370 : ideallog_sgn(GEN nf, GEN x, GEN sgn, GEN bid)
    2223             : {
    2224             :   pari_sp av;
    2225             :   long lcyc;
    2226             :   GEN den, cyc, y;
    2227             : 
    2228      200370 :   nf = checknf(nf); checkbid(bid);
    2229      200363 :   cyc = bid_get_cyc(bid);
    2230      200363 :   lcyc = lg(cyc); if (lcyc == 1) return cgetg(1, t_COL);
    2231      200335 :   av = avma;
    2232      200335 :   if (typ(x) == t_MAT) {
    2233       48371 :     if (lg(x) == 1) return zerocol(lcyc-1); /* x = 1 */
    2234       48371 :     y = famat_zlog(nf, x, sgn, bid);
    2235       48371 :     goto END;
    2236             :   }
    2237      151964 :   x = nf_to_scalar_or_basis(nf, x);
    2238      151964 :   switch(typ(x))
    2239             :   {
    2240             :     case t_INT:
    2241        8344 :       den = NULL;
    2242        8344 :       break;
    2243             :     case t_FRAC:
    2244           7 :       den = gel(x,2);
    2245           7 :       x = gel(x,1);
    2246           7 :       break;
    2247             :     default: /* case t_COL: */
    2248      143613 :       check_nfelt(x, &den);
    2249      143613 :       if (den) x = Q_muli_to_int(x, den);
    2250             :   }
    2251      151964 :   if (den)
    2252             :   {
    2253       47326 :     x = mkmat2(mkcol2(x, den), mkcol2(gen_1, gen_m1));
    2254       47326 :     y = famat_zlog(nf, x, sgn, bid);
    2255             :   }
    2256             :   else
    2257             :   {
    2258      104638 :     zlog_S S; init_zlog_bid(&S, bid);
    2259      104638 :     y = zlog(nf, x, sgn, &S);
    2260             :   }
    2261             : END:
    2262      200328 :   y = ZM_ZC_mul(bid_get_U(bid), y);
    2263      200328 :   return gerepileupto(av, vecmodii(y, cyc));
    2264             : }
    2265             : GEN
    2266      207076 : ideallog(GEN nf, GEN x, GEN bid)
    2267             : {
    2268      207076 :   if (!nf) return Zideallog(bid, x);
    2269      200370 :   return ideallog_sgn(nf, x, NULL, bid);
    2270             : }
    2271             : 
    2272             : /*************************************************************************/
    2273             : /**                                                                     **/
    2274             : /**               JOIN BID STRUCTURES, IDEAL LISTS                      **/
    2275             : /**                                                                     **/
    2276             : /*************************************************************************/
    2277             : 
    2278             : /* bid1, bid2: for coprime modules m1 and m2 (without arch. part).
    2279             :  * Output: bid [[m1 m2,arch],[h,[cyc],[gen]],idealfact,[liste],U] for m1 m2 */
    2280             : static GEN
    2281         476 : join_bid(GEN nf, GEN bid1, GEN bid2)
    2282             : {
    2283         476 :   pari_sp av = avma;
    2284             :   long nbgen, l1,l2;
    2285             :   GEN I1,I2, G1,G2, fa1,fa2, sprk1,sprk2, cyc1,cyc2;
    2286         476 :   GEN sprk, fa, U, cyc, y, u1 = NULL, x, gen;
    2287             : 
    2288         476 :   I1 = bid_get_ideal(bid1);
    2289         476 :   I2 = bid_get_ideal(bid2);
    2290         476 :   if (gequal1(gcoeff(I1,1,1))) return bid2; /* frequent trivial case */
    2291         259 :   G1 = bid_get_grp(bid1);
    2292         259 :   G2 = bid_get_grp(bid2);
    2293         259 :   fa1= bid_get_fact(bid1);
    2294         259 :   fa2= bid_get_fact(bid2); x = idealmul(nf, I1,I2);
    2295         259 :   fa = famat_mul_shallow(fa1, fa2);
    2296         259 :   sprk1 = bid_get_sprk(bid1);
    2297         259 :   sprk2 = bid_get_sprk(bid2);
    2298         259 :   sprk = shallowconcat(sprk1, sprk2);
    2299             : 
    2300         259 :   cyc1 = abgrp_get_cyc(G1); l1 = lg(cyc1);
    2301         259 :   cyc2 = abgrp_get_cyc(G2); l2 = lg(cyc2);
    2302         259 :   gen = (lg(G1)>3 && lg(G2)>3)? gen_1: NULL;
    2303         259 :   nbgen = l1+l2-2;
    2304         259 :   cyc = ZV_snf_group(shallowconcat(cyc1,cyc2), &U, gen? &u1: NULL);
    2305         259 :   if (nbgen) {
    2306         259 :     GEN U1 = bid_get_U(bid1), U2 = bid_get_U(bid2);
    2307         259 :     U1 = l1 == 1? zeromat(nbgen,lg(U1)-1): ZM_mul(vecslice(U, 1, l1-1),   U1);
    2308         259 :     U2 = l2 == 1? zeromat(nbgen,lg(U2)-1): ZM_mul(vecslice(U, l1, nbgen), U2);
    2309         259 :     U = shallowconcat(U1, U2);
    2310             :   }
    2311             :   else
    2312           0 :     U = zeromat(0, lg(sprk)-1);
    2313             : 
    2314         259 :   if (gen)
    2315             :   {
    2316         259 :     GEN uv = zkchinese1init2(nf, I2, I1, x);
    2317         518 :     gen = shallowconcat(zkVchinese1(gel(uv,1), abgrp_get_gen(G1)),
    2318         259 :                         zkVchinese1(gel(uv,2), abgrp_get_gen(G2)));
    2319             :   }
    2320         259 :   y = cgetg(6,t_VEC);
    2321         259 :   gel(y,1) = mkvec2(x, bid_get_arch(bid1));
    2322         259 :   gel(y,3) = fa;
    2323         259 :   gel(y,4) = mkvec3(sprk, bid_get_sarch(bid1), get_index(sprk));
    2324         259 :   gel(y,5) = U;
    2325         259 :   add_grp(nf, u1, cyc, gen, y);
    2326         259 :   return gerepilecopy(av,y);
    2327             : }
    2328             : 
    2329             : typedef struct _ideal_data {
    2330             :   GEN nf, emb, L, pr, prL, arch, sgnU;
    2331             : } ideal_data;
    2332             : 
    2333             : /* z <- ( z | f(v[i])_{i=1..#v} ) */
    2334             : static void
    2335       43414 : concat_join(GEN *pz, GEN v, GEN (*f)(ideal_data*,GEN), ideal_data *data)
    2336             : {
    2337       43414 :   long i, nz, lv = lg(v);
    2338             :   GEN z, Z;
    2339       86828 :   if (lv == 1) return;
    2340       18942 :   z = *pz; nz = lg(z)-1;
    2341       18942 :   *pz = Z = cgetg(lv + nz, typ(z));
    2342       18942 :   for (i = 1; i <=nz; i++) gel(Z,i) = gel(z,i);
    2343       18942 :   Z += nz;
    2344       18942 :   for (i = 1; i < lv; i++) gel(Z,i) = f(data, gel(v,i));
    2345             : }
    2346             : static GEN
    2347         476 : join_idealinit(ideal_data *D, GEN x) {
    2348         476 :   return join_bid(D->nf, x, D->prL);
    2349             : }
    2350             : static GEN
    2351       26222 : join_ideal(ideal_data *D, GEN x) {
    2352       26222 :   return idealmulpowprime(D->nf, x, D->pr, D->L);
    2353             : }
    2354             : static GEN
    2355         455 : join_unit(ideal_data *D, GEN x) {
    2356         455 :   return mkvec2(join_idealinit(D, gel(x,1)), vconcat(gel(x,2), D->emb));
    2357             : }
    2358             : 
    2359             : /* compute matrix of zlogs of units; sgnU = vector of signs of units at
    2360             :  * S.archp or NULL (S.archp empty) */
    2361             : GEN
    2362         434 : zlog_units(GEN nf, GEN U, GEN sgnU, GEN bid)
    2363             : {
    2364         434 :   long j, l = lg(U);
    2365         434 :   GEN m = cgetg(l, t_MAT);
    2366         434 :   zlog_S S; init_zlog_bid(&S, bid);
    2367         434 :   if (lg(S.archp) == 1) sgnU = NULL;
    2368         434 :   if (sgnU)
    2369             :   {
    2370          14 :     sgnU = rowpermute(sgnU, S.archp);
    2371          14 :     for (j = 1; j < l; j++) gel(m,j) = zlog(nf, gel(U,j), gel(sgnU,j), &S);
    2372             :   }
    2373             :   else
    2374             :   {
    2375         420 :     GEN empty = cgetg(1, t_VECSMALL);
    2376         420 :     for (j = 1; j < l; j++) gel(m,j) = zlog(nf, gel(U,j), empty, &S);
    2377             :   }
    2378         434 :   return m;
    2379             : }
    2380             : 
    2381             : /* archimedean part of units zlog */
    2382             : static GEN
    2383          28 : zlog_unitsarch(GEN sgnU, GEN bid)
    2384             : {
    2385          28 :   GEN sarch = bid_get_sarch(bid);
    2386          28 :   GEN m = rowpermute(sgnU, gel(sarch,4));
    2387          28 :   return Flm_mul(gel(sarch,3), m, 2);
    2388             : }
    2389             : 
    2390             : /*  flag & nf_GEN : generators, otherwise no
    2391             :  *  flag &2 : units, otherwise no
    2392             :  *  flag &4 : ideals in HNF, otherwise bid */
    2393             : static GEN
    2394         350 : Ideallist(GEN bnf, ulong bound, long flag)
    2395             : {
    2396         350 :   const long do_units = flag & 2, big_id = !(flag & 4);
    2397         350 :   const long istar_flag = (flag & nf_GEN) | nf_INIT;
    2398         350 :   pari_sp av, av0 = avma;
    2399             :   long i, j, l;
    2400         350 :   GEN nf, z, p, fa, id, BOUND, U, empty = cgetg(1,t_VEC);
    2401             :   forprime_t S;
    2402             :   ideal_data ID;
    2403         350 :   GEN (*join_z)(ideal_data*, GEN) =
    2404             :     do_units? &join_unit
    2405         350 :               : (big_id? &join_idealinit: &join_ideal);
    2406             : 
    2407         350 :   nf = checknf(bnf);
    2408         350 :   if ((long)bound <= 0) return empty;
    2409         350 :   id = matid(nf_get_degree(nf));
    2410         350 :   if (big_id) id = Idealstar(nf,id, istar_flag);
    2411             : 
    2412             :   /* z[i] will contain all "objects" of norm i. Depending on flag, this means
    2413             :    * an ideal, a bid, or a couple [bid, log(units)]. Such objects are stored
    2414             :    * in vectors, computed one primary component at a time; join_z
    2415             :    * reconstructs the global object */
    2416         350 :   BOUND = utoipos(bound);
    2417         350 :   z = cgetg(bound+1,t_VEC);
    2418         350 :   if (do_units) {
    2419          14 :     U = bnf_build_units(bnf);
    2420          14 :     gel(z,1) = mkvec( mkvec2(id, zlog_units(nf, U, NULL, id)) );
    2421             :   } else {
    2422         336 :     U = NULL; /* -Wall */
    2423         336 :     gel(z,1) = mkvec(id);
    2424             :   }
    2425         350 :   for (i=2; i<=(long)bound; i++) gel(z,i) = empty;
    2426         350 :   ID.nf = nf;
    2427             : 
    2428         350 :   p = cgetipos(3);
    2429         350 :   u_forprime_init(&S, 2, bound);
    2430         350 :   av = avma;
    2431        5726 :   while ((p[2] = u_forprime_next(&S)))
    2432             :   {
    2433        5026 :     if (DEBUGLEVEL>1) { err_printf("%ld ",p[2]); err_flush(); }
    2434        5026 :     fa = idealprimedec_limit_norm(nf, p, BOUND);
    2435       10073 :     for (j=1; j<lg(fa); j++)
    2436             :     {
    2437        5047 :       GEN pr = gel(fa,j), z2;
    2438        5047 :       ulong q, Q = upr_norm(pr);
    2439             : 
    2440        5047 :       z2 = leafcopy(z);
    2441        5047 :       q = Q;
    2442        5047 :       ID.pr = ID.prL = pr;
    2443       13370 :       for (l=1; Q <= bound; l++, Q *= q) /* add pr^l */
    2444             :       {
    2445             :         ulong iQ;
    2446        8323 :         ID.L = utoipos(l);
    2447        8323 :         if (big_id) {
    2448         217 :           ID.prL = Idealstarprk(nf, pr, l, istar_flag);
    2449         217 :           if (do_units) ID.emb = zlog_units(nf, U, NULL, ID.prL);
    2450             :         }
    2451       51737 :         for (iQ = Q,i = 1; iQ <= bound; iQ += Q,i++)
    2452       43414 :           concat_join(&gel(z,iQ), gel(z2,i), join_z, &ID);
    2453             :       }
    2454             :     }
    2455        5026 :     if (gc_needed(av,1))
    2456             :     {
    2457           0 :       if(DEBUGMEM>1) pari_warn(warnmem,"Ideallist");
    2458           0 :       z = gerepilecopy(av, z);
    2459             :     }
    2460             :   }
    2461         763 :   if (do_units) for (i = 1; i < lg(z); i++)
    2462             :   {
    2463         413 :     GEN s = gel(z,i);
    2464         413 :     long l = lg(s);
    2465         882 :     for (j = 1; j < l; j++) {
    2466         469 :       GEN v = gel(s,j), bid = gel(v,1);
    2467         469 :       gel(v,2) = ZM_mul(bid_get_U(bid), gel(v,2));
    2468             :     }
    2469             :   }
    2470         350 :   return gerepilecopy(av0, z);
    2471             : }
    2472             : GEN
    2473          28 : ideallist0(GEN bnf,long bound, long flag) {
    2474          28 :   if (flag<0 || flag>4) pari_err_FLAG("ideallist");
    2475          28 :   return Ideallist(bnf,bound,flag);
    2476             : }
    2477             : GEN
    2478         322 : ideallist(GEN bnf,long bound) { return Ideallist(bnf,bound,4); }
    2479             : 
    2480             : /* bid1 = for module m1 (without arch. part), arch = archimedean part.
    2481             :  * Output: bid [[m1,arch],[h,[cyc],[gen]],idealfact,[liste],U] for m1.arch */
    2482             : static GEN
    2483          56 : join_bid_arch(GEN nf, GEN bid1, GEN arch)
    2484             : {
    2485          56 :   pari_sp av = avma;
    2486             :   GEN G1, fa1, U;
    2487          56 :   GEN sprk, cyc, y, u1 = NULL, x, sarch, gen;
    2488             : 
    2489          56 :   checkbid(bid1);
    2490          56 :   G1 = bid_get_grp(bid1);
    2491          56 :   fa1= bid_get_fact(bid1);
    2492          56 :   x = bid_get_ideal(bid1);
    2493          56 :   sarch = nfarchstar(nf, x, arch);
    2494          56 :   sprk = bid_get_sprk(bid1);
    2495             : 
    2496          56 :   gen = (lg(G1)>3)? gen_1: NULL;
    2497          56 :   cyc = diagonal_shallow(shallowconcat(gel(G1,2), gel(sarch,1)));
    2498          56 :   cyc = ZM_snf_group(cyc, &U, gen? &u1: NULL);
    2499          56 :   if (gen) gen = shallowconcat(gel(G1,3), gel(sarch,2));
    2500          56 :   y = cgetg(6,t_VEC);
    2501          56 :   gel(y,1) = mkvec2(x, arch);
    2502          56 :   gel(y,3) = fa1;
    2503          56 :   gel(y,4) = mkvec3(sprk, sarch, get_index(sprk));
    2504          56 :   gel(y,5) = U;
    2505          56 :   add_grp(nf, u1, cyc, gen, y);
    2506          56 :   return gerepilecopy(av,y);
    2507             : }
    2508             : static GEN
    2509          56 : join_arch(ideal_data *D, GEN x) {
    2510          56 :   return join_bid_arch(D->nf, x, D->arch);
    2511             : }
    2512             : static GEN
    2513          28 : join_archunit(ideal_data *D, GEN x) {
    2514          28 :   GEN bid = join_arch(D, gel(x,1)), u = gel(x,2);
    2515          28 :   u = ZM_mul(bid_get_U(bid), vconcat(u, zm_to_ZM(zlog_unitsarch(D->sgnU,bid))));
    2516          28 :   return mkvec2(bid, u);
    2517             : }
    2518             : 
    2519             : /* L from ideallist, add archimedean part */
    2520             : GEN
    2521          14 : ideallistarch(GEN bnf, GEN L, GEN arch)
    2522             : {
    2523             :   pari_sp av;
    2524          14 :   long i, j, l = lg(L), lz;
    2525             :   GEN v, z, V;
    2526             :   ideal_data ID;
    2527             :   GEN (*join_z)(ideal_data*, GEN);
    2528             : 
    2529          14 :   if (typ(L) != t_VEC) pari_err_TYPE("ideallistarch",L);
    2530          14 :   if (l == 1) return cgetg(1,t_VEC);
    2531          14 :   z = gel(L,1);
    2532          14 :   if (typ(z) != t_VEC) pari_err_TYPE("ideallistarch",z);
    2533          14 :   z = gel(z,1); /* either a bid or [bid,U] */
    2534          14 :   if (lg(z) == 3) { /* the latter: do units */
    2535           7 :     if (typ(z) != t_VEC) pari_err_TYPE("ideallistarch",z);
    2536           7 :     ID.sgnU = nfsign_units(bnf, NULL, 1);
    2537           7 :     join_z = &join_archunit;
    2538             :   } else
    2539           7 :     join_z = &join_arch;
    2540          14 :   ID.nf = checknf(bnf);
    2541          14 :   ID.arch = vec01_to_indices(arch);
    2542          14 :   av = avma; V = cgetg(l, t_VEC);
    2543          70 :   for (i = 1; i < l; i++)
    2544             :   {
    2545          56 :     z = gel(L,i); lz = lg(z);
    2546          56 :     gel(V,i) = v = cgetg(lz,t_VEC);
    2547          56 :     for (j=1; j<lz; j++) gel(v,j) = join_z(&ID, gel(z,j));
    2548             :   }
    2549          14 :   return gerepilecopy(av,V);
    2550             : }

Generated by: LCOV version 1.11