[BACK]Return to array.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Diff for /OpenXM_contrib2/asir2000/builtin/array.c between version 1.3 and 1.76

version 1.3, 2000/04/20 02:20:15 version 1.76, 2018/03/29 01:32:50
Line 1 
Line 1 
 /* $OpenXM: OpenXM_contrib2/asir2000/builtin/array.c,v 1.2 2000/03/14 05:25:43 noro Exp $ */  /*
    * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
    * All rights reserved.
    *
    * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
    * non-exclusive and royalty-free license to use, copy, modify and
    * redistribute, solely for non-commercial and non-profit purposes, the
    * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
    * conditions of this Agreement. For the avoidance of doubt, you acquire
    * only a limited right to use the SOFTWARE hereunder, and FLL or any
    * third party developer retains all rights, including but not limited to
    * copyrights, in and to the SOFTWARE.
    *
    * (1) FLL does not grant you a license in any way for commercial
    * purposes. You may use the SOFTWARE only for non-commercial and
    * non-profit purposes only, such as academic, research and internal
    * business use.
    * (2) The SOFTWARE is protected by the Copyright Law of Japan and
    * international copyright treaties. If you make copies of the SOFTWARE,
    * with or without modification, as permitted hereunder, you shall affix
    * to all such copies of the SOFTWARE the above copyright notice.
    * (3) An explicit reference to this SOFTWARE and its copyright owner
    * shall be made on your publication or presentation in any form of the
    * results obtained by use of the SOFTWARE.
    * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
    * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
    * for such modification or the source code of the modified part of the
    * SOFTWARE.
    *
    * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
    * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
    * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
    * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
    * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
    * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
    * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
    * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
    * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
    * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
    * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
    * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
    * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
    * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
    * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
    * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
    * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
    *
    * $OpenXM: OpenXM_contrib2/asir2000/builtin/array.c,v 1.75 2017/09/17 02:34:02 noro Exp $
   */
 #include "ca.h"  #include "ca.h"
 #include "base.h"  #include "base.h"
 #include "parse.h"  #include "parse.h"
 #include "inline.h"  #include "inline.h"
 /*  
   #include <sys/types.h>
   #include <sys/stat.h>
   #if !defined(_MSC_VER)
   #include <unistd.h>
   #endif
   
   #define F4_INTRAT_PERIOD 8
   
   #if 0
 #undef DMAR  #undef DMAR
 #define DMAR(a1,a2,a3,d,r) (r)=dmar(a1,a2,a3,d);  #define DMAR(a1,a2,a3,d,r) (r)=dmar(a1,a2,a3,d);
 */  #endif
   
 extern int Print; /* XXX */  extern int DP_Print; /* XXX */
   
 void inner_product_mat_int_mod(Q **,int **,int,int,int,Q *);  
 void solve_by_lu_mod(int **,int,int,int **,int);  
 void solve_by_lu_gfmmat(GFMMAT,unsigned int,unsigned int *,unsigned int *);  
 int lu_gfmmat(GFMMAT,unsigned int,int *);  
 void mat_to_gfmmat(MAT,unsigned int,GFMMAT *);  
   
 int generic_gauss_elim_mod(int **,int,int,int,int *);  void Pnewvect(), Pnewmat(), Psepvect(), Psize(), Pdet(), Pleqm(), Pleqm1(), Pgeninvm(), Ptriangleq();
 int generic_gauss_elim(MAT ,MAT *,Q *,int **,int **);  void Pinvmat();
   void Pnewbytearray(),Pmemoryplot_to_coord();
   
 int gauss_elim_mod(int **,int,int,int);  void Pgeneric_gauss_elim();
 int gauss_elim_mod1(int **,int,int,int);  
 int gauss_elim_geninv_mod(unsigned int **,int,int,int);  
 int gauss_elim_geninv_mod_swap(unsigned int **,int,int,unsigned int,unsigned int ***,int **);  
 void Pnewvect(), Pnewmat(), Psepvect(), Psize(), Pdet(), Pleqm(), Pleqm1(), Pgeninvm();  
   
 void Pgeneric_gauss_elim_mod();  void Pgeneric_gauss_elim_mod();
   
   void Pindep_rows_mod();
   
 void Pmat_to_gfmmat(),Plu_gfmmat(),Psolve_by_lu_gfmmat();  void Pmat_to_gfmmat(),Plu_gfmmat(),Psolve_by_lu_gfmmat();
 void Pgeninvm_swap(), Premainder(), Psremainder(), Pvtol();  void Pgeninvm_swap(), Premainder(), Psremainder(), Pvtol(), Pltov();
   void Pgeninv_sf_swap();
 void sepvect();  void sepvect();
 void Pmulmat_gf2n();  void Pmulmat_gf2n();
 void Pbconvmat_gf2n();  void Pbconvmat_gf2n();
Line 40  void Px962_irredpoly_up2();
Line 91  void Px962_irredpoly_up2();
 void Pirredpoly_up2();  void Pirredpoly_up2();
 void Pnbpoly_up2();  void Pnbpoly_up2();
 void Pqsort();  void Pqsort();
   void Pexponent_vector();
   void Pmat_swap_row_destructive();
   void Pmat_swap_col_destructive();
   void Pvect();
   void Pmat();
   void Pmatc();
   void Pnd_det();
   void Plu_mat();
   void Pmat_col();
   void Plusolve_prep();
   void Plusolve_main();
   
 struct ftab array_tab[] = {  struct ftab array_tab[] = {
         {"solve_by_lu_gfmmat",Psolve_by_lu_gfmmat,4},    {"lu_mat",Plu_mat,1},
         {"lu_gfmmat",Plu_gfmmat,2},    {"solve_by_lu_gfmmat",Psolve_by_lu_gfmmat,4},
         {"mat_to_gfmmat",Pmat_to_gfmmat,2},    {"lu_gfmmat",Plu_gfmmat,2},
         {"generic_gauss_elim_mod",Pgeneric_gauss_elim_mod,2},    {"mat_to_gfmmat",Pmat_to_gfmmat,2},
         {"newvect",Pnewvect,-2},    {"generic_gauss_elim",Pgeneric_gauss_elim,1},
         {"newmat",Pnewmat,-3},    {"generic_gauss_elim_mod",Pgeneric_gauss_elim_mod,2},
         {"sepmat_destructive",Psepmat_destructive,2},    {"indep_rows_mod",Pindep_rows_mod,2},
         {"sepvect",Psepvect,2},    {"newvect",Pnewvect,-2},
         {"qsort",Pqsort,-2},    {"vect",Pvect,-99999999},
         {"vtol",Pvtol,1},    {"vector",Pnewvect,-2},
         {"size",Psize,1},    {"exponent_vector",Pexponent_vector,-99999999},
         {"det",Pdet,-2},    {"newmat",Pnewmat,-3},
         {"leqm",Pleqm,2},    {"matrix",Pnewmat,-3},
         {"leqm1",Pleqm1,2},    {"mat",Pmat,-99999999},
         {"geninvm",Pgeninvm,2},    {"matr",Pmat,-99999999},
         {"geninvm_swap",Pgeninvm_swap,2},    {"matc",Pmatc,-99999999},
         {"remainder",Premainder,2},    {"newbytearray",Pnewbytearray,-2},
         {"sremainder",Psremainder,2},    {"memoryplot_to_coord",Pmemoryplot_to_coord,1},
         {"mulmat_gf2n",Pmulmat_gf2n,1},    {"sepmat_destructive",Psepmat_destructive,2},
         {"bconvmat_gf2n",Pbconvmat_gf2n,-4},    {"sepvect",Psepvect,2},
         {"mul_vect_mat_gf2n",Pmul_vect_mat_gf2n,2},    {"qsort",Pqsort,-2},
         {"mul_mat_vect_int",Pmul_mat_vect_int,2},    {"vtol",Pvtol,1},
         {"nbmul_gf2n",PNBmul_gf2n,3},    {"ltov",Pltov,1},
         {"x962_irredpoly_up2",Px962_irredpoly_up2,2},    {"size",Psize,1},
         {"irredpoly_up2",Pirredpoly_up2,2},    {"det",Pdet,-2},
         {"nbpoly_up2",Pnbpoly_up2,2},    {"nd_det",Pnd_det,-2},
         {0,0,0},    {"invmat",Pinvmat,-2},
     {"leqm",Pleqm,2},
     {"leqm1",Pleqm1,2},
     {"geninvm",Pgeninvm,2},
     {"geninvm_swap",Pgeninvm_swap,2},
     {"geninv_sf_swap",Pgeninv_sf_swap,1},
     {"remainder",Premainder,2},
     {"sremainder",Psremainder,2},
     {"mulmat_gf2n",Pmulmat_gf2n,1},
     {"bconvmat_gf2n",Pbconvmat_gf2n,-4},
     {"mul_vect_mat_gf2n",Pmul_vect_mat_gf2n,2},
     {"mul_mat_vect_int",Pmul_mat_vect_int,2},
     {"nbmul_gf2n",PNBmul_gf2n,3},
     {"x962_irredpoly_up2",Px962_irredpoly_up2,2},
     {"irredpoly_up2",Pirredpoly_up2,2},
     {"nbpoly_up2",Pnbpoly_up2,2},
     {"mat_swap_row_destructive",Pmat_swap_row_destructive,3},
     {"mat_swap_col_destructive",Pmat_swap_col_destructive,3},
     {"mat_col",Pmat_col,2},
     {"lusolve_prep",Plusolve_prep,1},
     {"lusolve_main",Plusolve_main,1},
     {"triangleq",Ptriangleq,1},
     {0,0,0},
 };  };
   
 int comp_obj(a,b)  typedef struct _ent { int j; unsigned int e; } ent;
 Obj *a,*b;  
   ent *get_row(FILE *,int *l);
   void put_row(FILE *out,int l,ent *a);
   void lu_elim(int *l,ent **a,int k,int i,int mul,int mod);
   void lu_append(int *,ent **,int *,int,int,int);
   void solve_l(int *,ent **,int,int *,int);
   void solve_u(int *,ent **,int,int *,int);
   
   
   static int *ul,*ll;
   static ent **u,**l;
   static int modulus;
   
   void Plusolve_prep(NODE arg,Q *rp)
 {  {
         return arf_comp(CO,*a,*b);    char *fname;
     FILE *in;
     int len,i,rank;
     int *rhs;
   
     fname = BDY((STRING)ARG0(arg));
     in = fopen(fname,"r");
     modulus = getw(in);
     len = getw(in);
     ul = (int *)MALLOC_ATOMIC(len*sizeof(int));
     u = (ent **)MALLOC(len*sizeof(ent *));
     ll = (int *)MALLOC_ATOMIC(len*sizeof(int));
     l = (ent **)MALLOC(len*sizeof(ent *));
     for ( i = 0; i < len; i++ ) {
       u[i] = get_row(in,&ul[i]);
     }
     for ( i = 0; i < len; i++ ) {
       l[i] = get_row(in,&ll[i]);
     }
     fclose(in);
     *rp = ONE;
 }  }
   
   void Plusolve_main(NODE arg,VECT *rp)
   {
     Q *d,*p;
     VECT v,r;
     int len,i;
     int *rhs;
   
     v = (VECT)ARG0(arg); len = v->len;
     d = (Q *)BDY(v);
     rhs = (int *)MALLOC_ATOMIC(len*sizeof(int));
     for ( i = 0; i < len; i++ ) rhs[i] = QTOS(d[i]);
     solve_l(ll,l,len,rhs,modulus);
     solve_u(ul,u,len,rhs,modulus);
     NEWVECT(r); r->len = len;
     r->body = (pointer *)MALLOC(len*sizeof(pointer));
     p = (Q *)r->body;
     for ( i = 0; i < len; i++ )
       STOQ(rhs[i],p[i]);
     *rp = r;
   }
   
   ent *get_row(FILE *in,int *l)
   {
     int len,i;
     ent *a;
   
     *l = len = getw(in);
     a = (ent *)MALLOC_ATOMIC(len*sizeof(ent));
     for ( i = 0; i < len; i++ ) {
       a[i].j = getw(in);
       a[i].e = getw(in);
     }
     return a;
   }
   
   void lu_gauss(int *ul,ent **u,int *ll,ent **l,int n,int mod)
   {
     int i,j,k,s,mul;
     unsigned int inv;
     int *ll2;
   
     ll2 = (int *)MALLOC_ATOMIC(n*sizeof(int));
     for ( i = 0; i < n; i++ ) ll2[i] = 0;
     for ( i = 0; i < n; i++ ) {
       fprintf(stderr,"i=%d\n",i);
       inv = invm(u[i][0].e,mod);
       for ( k = i+1; k < n; k++ )
         if ( u[k][0].j == n-i ) {
           s = u[k][0].e;
           DMAR(s,inv,0,mod,mul);
           lu_elim(ul,u,k,i,mul,mod);
           lu_append(ll,l,ll2,k,i,mul);
         }
     }
   }
   
   #define INITLEN 10
   
   void lu_append(int *l,ent **a,int *l2,int k,int i,int mul)
   {
     int len;
     ent *p;
   
     len = l[k];
     if ( !len ) {
       a[k] = p = (ent *)MALLOC_ATOMIC(INITLEN*sizeof(ent));
       p[0].j = i; p[0].e = mul;
       l[k] = 1; l2[k] = INITLEN;
     } else {
       if ( l2[k] == l[k] ) {
         l2[k] *= 2;
         a[k] = REALLOC(a[k],l2[k]*sizeof(ent));
       }
       p =a[k];
       p[l[k]].j = i; p[l[k]].e = mul;
       l[k]++;
     }
   }
   
   /* a[k] = a[k]-mul*a[i] */
   
   void lu_elim(int *l,ent **a,int k,int i,int mul,int mod)
   {
     ent *ak,*ai,*w;
     int lk,li,j,m,p,q,r,s,t,j0;
   
     ak = a[k]; ai = a[i]; lk = l[k]; li = l[i];
     w = (ent *)alloca((lk+li)*sizeof(ent));
     p = 0; q = 0; j = 0;
     mul = mod-mul;
     while ( p < lk && q < li ) {
       if ( ak[p].j > ai[q].j ) {
         w[j] = ak[p]; j++; p++;
       } else if ( ak[p].j < ai[q].j ) {
         w[j].j = ai[q].j;
         t = ai[q].e;
         DMAR(t,mul,0,mod,r);
         w[j].e = r;
         j++; q++;
       } else {
         t = ai[q].e; s = ak[p].e;
         DMAR(t,mul,s,mod,r);
         if ( r ) {
           w[j].j = ai[q].j; w[j].e = r; j++;
         }
         p++; q++;
       }
     }
     if ( q == li )
       while ( p < lk ) {
         w[j] = ak[p]; j++; p++;
       }
     else if ( p == lk )
       while ( q < li ) {
         w[j].j = ai[q].j;
         t = ai[q].e;
         DMAR(t,mul,0,mod,r);
         w[j].e = r;
         j++; q++;
       }
     if ( j <= lk ) {
       for ( m = 0; m < j; m++ ) ak[m] = w[m];
     } else {
       a[k] = ak = (ent *)MALLOC_ATOMIC(j*sizeof(ent));
       for ( m = 0; m < j; m++ ) ak[m] = w[m];
     }
     l[k] = j;
   }
   
   void solve_l(int *ll,ent **l,int n,int *rhs,int mod)
   {
     int j,k,s,len;
     ent *p;
   
     for ( j = 0; j < n; j++ ) {
       len = ll[j]; p = l[j];
       for ( k = 0, s = 0; k < len; k++ )
         s = dmar(p[k].e,rhs[p[k].j],s,mod);
       rhs[j] -=  s;
       if ( rhs[j] < 0 ) rhs[j] += mod;
     }
   }
   
   void solve_u(int *ul,ent **u,int n,int *rhs,int mod)
   {
     int j,k,s,len,inv;
     ent *p;
   
     for ( j = n-1; j >= 0; j-- ) {
       len = ul[j]; p = u[j];
       for ( k = 1, s = 0; k < len; k++ )
         s = dmar(p[k].e,rhs[p[k].j],s,mod);
       rhs[j] -=  s;
       if ( rhs[j] < 0 ) rhs[j] += mod;
       inv = invm((unsigned int)p[0].e,mod);
       rhs[j] = dmar(rhs[j],inv,0,mod);
     }
   }
   
   int comp_obj(Obj *a,Obj *b)
   {
     return arf_comp(CO,*a,*b);
   }
   
 static FUNC generic_comp_obj_func;  static FUNC generic_comp_obj_func;
 static NODE generic_comp_obj_arg;  static NODE generic_comp_obj_arg;
   static NODE generic_comp_obj_option;
   
 int generic_comp_obj(a,b)  int generic_comp_obj(Obj *a,Obj *b)
 Obj *a,*b;  
 {  {
         Q r;    Q r;
   
         BDY(generic_comp_obj_arg)=(pointer)(*a);    BDY(generic_comp_obj_arg)=(pointer)(*a);
         BDY(NEXT(generic_comp_obj_arg))=(pointer)(*b);    BDY(NEXT(generic_comp_obj_arg))=(pointer)(*b);
         r = (Q)bevalf(generic_comp_obj_func,generic_comp_obj_arg);    r = (Q)bevalf_with_opts(generic_comp_obj_func,generic_comp_obj_arg,generic_comp_obj_option);
         if ( !r )    if ( !r )
                 return 0;      return 0;
         else    else
                 return SGN(r)>0?1:-1;      return SGN(r)>0?1:-1;
 }  }
   
   
 void Pqsort(arg,rp)  void Pqsort(NODE arg,LIST *rp)
 NODE arg;  
 VECT *rp;  
 {  {
         VECT vect;    VECT vect;
         char buf[BUFSIZ];    NODE n,n1;
         char *fname;    P p;
         NODE n;    V v;
         P p;    FUNC func;
         V v;    int len,i;
     pointer *a;
     Obj t;
   
         asir_assert(ARG0(arg),O_VECT,"qsort");    t = ARG0(arg);
         vect = (VECT)ARG0(arg);      if (OID(t) == O_LIST) {
         if ( argc(arg) == 1 )          n = (NODE)BDY((LIST)t);
                 qsort(BDY(vect),vect->len,sizeof(Obj),(int (*)(const void *,const void *))comp_obj);          len = length(n);
         else {          MKVECT(vect,len);
                 p = (P)ARG1(arg);          for ( i = 0; i < len; i++, n = NEXT(n) ) {
                 if ( !p || OID(p)!=2 )              BDY(vect)[i] = BDY(n);
                         error("qsort : invalid argument");          }
                 v = VR(p);  
                 if ( (int)v->attr != V_SR )      }else if (OID(t) != O_VECT) {
                         error("qsort : no such function");          error("qsort : invalid argument");
                 generic_comp_obj_func = (FUNC)v->priv;      }else {
                 MKNODE(n,0,0); MKNODE(generic_comp_obj_arg,0,n);          vect = (VECT)t;
                 qsort(BDY(vect),vect->len,sizeof(Obj),(int (*)(const void *,const void *))generic_comp_obj);      }
         }    if ( argc(arg) == 1 )
         *rp = vect;      qsort(BDY(vect),vect->len,sizeof(Obj),(int (*)(const void *,const void *))comp_obj);
     else {
       p = (P)ARG1(arg);
       if ( !p || OID(p)!=2 )
         error("qsort : invalid argument");
       v = VR(p);
       gen_searchf(NAME(v),&func);
       if ( !func ) {
         if ( (int)v->attr != V_SR )
           error("qsort : no such function");
         func = (FUNC)v->priv;
       }
       generic_comp_obj_func = func;
       MKNODE(n,0,0); MKNODE(generic_comp_obj_arg,0,n);
       generic_comp_obj_option = current_option;
       qsort(BDY(vect),vect->len,sizeof(Obj),(int (*)(const void *,const void *))generic_comp_obj);
     }
       if (OID(t) == O_LIST) {
           a = BDY(vect);
           for ( i = len - 1, n = 0; i >= 0; i-- ) {
               MKNODE(n1,a[i],n); n = n1;
           }
           MKLIST(*rp,n);
       }else {
           *rp = (LIST)vect;
       }
 }  }
   
 void PNBmul_gf2n(arg,rp)  void PNBmul_gf2n(NODE arg,GF2N *rp)
 NODE arg;  
 GF2N *rp;  
 {  {
         GF2N a,b;    GF2N a,b;
         GF2MAT mat;    GF2MAT mat;
         int n,w;    int n,w;
         unsigned int *ab,*bb;    unsigned int *ab,*bb;
         UP2 r;    UP2 r;
   
         a = (GF2N)ARG0(arg);    a = (GF2N)ARG0(arg);
         b = (GF2N)ARG1(arg);    b = (GF2N)ARG1(arg);
         mat = (GF2MAT)ARG2(arg);    mat = (GF2MAT)ARG2(arg);
         if ( !a || !b )    if ( !a || !b )
                 *rp = 0;      *rp = 0;
         else {    else {
                 n = mat->row;      n = mat->row;
                 w = (n+BSH-1)/BSH;      w = (n+BSH-1)/BSH;
   
                 ab = (unsigned int *)ALLOCA(w*sizeof(unsigned int));      ab = (unsigned int *)ALLOCA(w*sizeof(unsigned int));
                 bzero((char *)ab,w*sizeof(unsigned int));      bzero((char *)ab,w*sizeof(unsigned int));
                 bcopy(a->body->b,ab,(a->body->w)*sizeof(unsigned int));      bcopy(a->body->b,ab,(a->body->w)*sizeof(unsigned int));
   
                 bb = (unsigned int *)ALLOCA(w*sizeof(unsigned int));      bb = (unsigned int *)ALLOCA(w*sizeof(unsigned int));
                 bzero((char *)bb,w*sizeof(unsigned int));      bzero((char *)bb,w*sizeof(unsigned int));
                 bcopy(b->body->b,bb,(b->body->w)*sizeof(unsigned int));      bcopy(b->body->b,bb,(b->body->w)*sizeof(unsigned int));
   
                 NEWUP2(r,w);      NEWUP2(r,w);
                 bzero((char *)r->b,w*sizeof(unsigned int));      bzero((char *)r->b,w*sizeof(unsigned int));
                 mul_nb(mat,ab,bb,r->b);      mul_nb(mat,ab,bb,r->b);
                 r->w = w;      r->w = w;
                 _adjup2(r);      _adjup2(r);
                 if ( !r->w )      if ( !r->w )
                         *rp = 0;        *rp = 0;
                 else      else
                         MKGF2N(r,*rp);        MKGF2N(r,*rp);
         }    }
 }  }
   
 void Pmul_vect_mat_gf2n(arg,rp)  void Pmul_vect_mat_gf2n(NODE arg,GF2N *rp)
 NODE arg;  
 GF2N *rp;  
 {  {
         GF2N a;    GF2N a;
         GF2MAT mat;    GF2MAT mat;
         int n,w;    int n,w;
         unsigned int *b;    unsigned int *b;
         UP2 r;    UP2 r;
   
         a = (GF2N)ARG0(arg);    a = (GF2N)ARG0(arg);
         mat = (GF2MAT)ARG1(arg);    mat = (GF2MAT)ARG1(arg);
         if ( !a )    if ( !a )
                 *rp = 0;      *rp = 0;
         else {    else {
                 n = mat->row;      n = mat->row;
                 w = (n+BSH-1)/BSH;      w = (n+BSH-1)/BSH;
                 b = (unsigned int *)ALLOCA(w*sizeof(unsigned int));      b = (unsigned int *)ALLOCA(w*sizeof(unsigned int));
                 bzero((char *)b,w*sizeof(unsigned int));      bzero((char *)b,w*sizeof(unsigned int));
                 bcopy(a->body->b,b,(a->body->w)*sizeof(unsigned int));      bcopy(a->body->b,b,(a->body->w)*sizeof(unsigned int));
                 NEWUP2(r,w);      NEWUP2(r,w);
                 bzero((char *)r->b,w*sizeof(unsigned int));      bzero((char *)r->b,w*sizeof(unsigned int));
                 mulgf2vectmat(mat->row,b,mat->body,r->b);      mulgf2vectmat(mat->row,b,mat->body,r->b);
                 r->w = w;      r->w = w;
                 _adjup2(r);      _adjup2(r);
                 if ( !r->w )      if ( !r->w )
                         *rp = 0;        *rp = 0;
                 else {      else {
                         MKGF2N(r,*rp);        MKGF2N(r,*rp);
                 }      }
         }    }
 }  }
   
 void Pbconvmat_gf2n(arg,rp)  void Pbconvmat_gf2n(NODE arg,LIST *rp)
 NODE arg;  
 LIST *rp;  
 {  {
         P p0,p1;    P p0,p1;
         int to;    int to;
         GF2MAT p01,p10;    GF2MAT p01,p10;
         GF2N root;    GF2N root;
         NODE n0,n1;    NODE n0,n1;
   
         p0 = (P)ARG0(arg);    p0 = (P)ARG0(arg);
         p1 = (P)ARG1(arg);    p1 = (P)ARG1(arg);
         to = ARG2(arg)?1:0;    to = ARG2(arg)?1:0;
         if ( argc(arg) == 4 ) {    if ( argc(arg) == 4 ) {
                 root = (GF2N)ARG3(arg);      root = (GF2N)ARG3(arg);
                 compute_change_of_basis_matrix_with_root(p0,p1,to,root,&p01,&p10);      compute_change_of_basis_matrix_with_root(p0,p1,to,root,&p01,&p10);
         } else    } else
                 compute_change_of_basis_matrix(p0,p1,to,&p01,&p10);      compute_change_of_basis_matrix(p0,p1,to,&p01,&p10);
         MKNODE(n1,p10,0); MKNODE(n0,p01,n1);    MKNODE(n1,p10,0); MKNODE(n0,p01,n1);
         MKLIST(*rp,n0);    MKLIST(*rp,n0);
 }  }
   
 void Pmulmat_gf2n(arg,rp)  void Pmulmat_gf2n(NODE arg,GF2MAT *rp)
 NODE arg;  
 GF2MAT *rp;  
 {  {
         GF2MAT m;    GF2MAT m;
   
         if ( !compute_multiplication_matrix((P)ARG0(arg),&m) )    if ( !compute_multiplication_matrix((P)ARG0(arg),&m) )
                 error("mulmat_gf2n : input is not a normal polynomial");      error("mulmat_gf2n : input is not a normal polynomial");
         *rp = m;    *rp = m;
 }  }
   
 void Psepmat_destructive(arg,rp)  void Psepmat_destructive(NODE arg,LIST *rp)
 NODE arg;  
 LIST *rp;  
 {  {
         MAT mat,mat1;    MAT mat,mat1;
         int i,j,row,col;    int i,j,row,col;
         Q **a,**a1;    Q **a,**a1;
         Q ent;    Q ent;
         N nm,mod,rem,quo;    N nm,mod,rem,quo;
         int sgn;    int sgn;
         NODE n0,n1;    NODE n0,n1;
   
         mat = (MAT)ARG0(arg); mod = NM((Q)ARG1(arg));    mat = (MAT)ARG0(arg); mod = NM((Q)ARG1(arg));
         row = mat->row; col = mat->col;    row = mat->row; col = mat->col;
         MKMAT(mat1,row,col);    MKMAT(mat1,row,col);
         a = (Q **)mat->body; a1 = (Q **)mat1->body;    a = (Q **)mat->body; a1 = (Q **)mat1->body;
         for ( i = 0; i < row; i++ )    for ( i = 0; i < row; i++ )
                 for ( j = 0; j < col; j++ ) {      for ( j = 0; j < col; j++ ) {
                         ent = a[i][j];        ent = a[i][j];
                         if ( !ent )        if ( !ent )
                                 continue;          continue;
                         nm = NM(ent);        nm = NM(ent);
                         sgn = SGN(ent);        sgn = SGN(ent);
                         divn(nm,mod,&quo,&rem);        divn(nm,mod,&quo,&rem);
 /*                      if ( quo != nm && rem != nm ) */  /*      if ( quo != nm && rem != nm ) */
 /*                              GC_free(nm); */  /*        GCFREE(nm); */
 /*                      GC_free(ent); */  /*      GCFREE(ent); */
                         NTOQ(rem,sgn,a[i][j]); NTOQ(quo,sgn,a1[i][j]);        NTOQ(rem,sgn,a[i][j]); NTOQ(quo,sgn,a1[i][j]);
                 }      }
         MKNODE(n1,mat1,0); MKNODE(n0,mat,n1);    MKNODE(n1,mat1,0); MKNODE(n0,mat,n1);
         MKLIST(*rp,n0);    MKLIST(*rp,n0);
 }  }
   
 void Psepvect(arg,rp)  void Psepvect(NODE arg,VECT *rp)
 NODE arg;  
 VECT *rp;  
 {  {
         sepvect((VECT)ARG0(arg),QTOS((Q)ARG1(arg)),rp);    sepvect((VECT)ARG0(arg),QTOS((Q)ARG1(arg)),rp);
 }  }
   
 void sepvect(v,d,rp)  void sepvect(VECT v,int d,VECT *rp)
 VECT v;  
 int d;  
 VECT *rp;  
 {  {
         int i,j,k,n,q,q1,r;    int i,j,k,n,q,q1,r;
         pointer *pv,*pw,*pu;    pointer *pv,*pw,*pu;
         VECT w,u;    VECT w,u;
   
         n = v->len;    n = v->len;
         if ( d > n )    if ( d > n )
                 d = n;      d = n;
         q = n/d; r = n%d; q1 = q+1;    q = n/d; r = n%d; q1 = q+1;
         MKVECT(w,d); *rp = w;    MKVECT(w,d); *rp = w;
         pv = BDY(v); pw = BDY(w); k = 0;    pv = BDY(v); pw = BDY(w); k = 0;
         for ( i = 0; i < r; i++ ) {    for ( i = 0; i < r; i++ ) {
                 MKVECT(u,q1); pw[i] = (pointer)u;      MKVECT(u,q1); pw[i] = (pointer)u;
                 for ( pu = BDY(u), j = 0; j < q1; j++, k++ )      for ( pu = BDY(u), j = 0; j < q1; j++, k++ )
                         pu[j] = pv[k];        pu[j] = pv[k];
         }    }
         for ( ; i < d; i++ ) {    for ( ; i < d; i++ ) {
                 MKVECT(u,q); pw[i] = (pointer)u;      MKVECT(u,q); pw[i] = (pointer)u;
                 for ( pu = BDY(u), j = 0; j < q; j++, k++ )      for ( pu = BDY(u), j = 0; j < q; j++, k++ )
                         pu[j] = pv[k];        pu[j] = pv[k];
         }    }
 }  }
   
 void Pnewvect(arg,rp)  void Pnewvect(NODE arg,VECT *rp)
 NODE arg;  
 VECT *rp;  
 {  {
         int len,i,r;    int len,i,r;
         VECT vect;    VECT vect;
         pointer *vb;    pointer *vb;
         LIST list;    LIST list;
         NODE tn;    NODE tn;
   
         asir_assert(ARG0(arg),O_N,"newvect");    asir_assert(ARG0(arg),O_N,"newvect");
         len = QTOS((Q)ARG0(arg));    len = QTOS((Q)ARG0(arg));
         if ( len <= 0 )    if ( len < 0 )
                 error("newvect : invalid size");      error("newvect : invalid size");
         MKVECT(vect,len);    MKVECT(vect,len);
         if ( argc(arg) == 2 ) {    if ( argc(arg) == 2 ) {
                 list = (LIST)ARG1(arg);      list = (LIST)ARG1(arg);
                 asir_assert(list,O_LIST,"newvect");      asir_assert(list,O_LIST,"newvect");
                 for ( r = 0, tn = BDY(list); tn; r++, tn = NEXT(tn) );  #if 0
                 if ( r > len ) {      for ( r = 0, tn = BDY(list); tn; r++, tn = NEXT(tn) );
                         *rp = vect;      if ( r > len ) {
                         return;        *rp = vect;
                 }        return;
                 for ( i = 0, tn = BDY(list), vb = BDY(vect); tn; i++, tn = NEXT(tn) )      }
                         vb[i] = (pointer)BDY(tn);  #endif
         }      for ( i = 0, tn = BDY(list), vb = BDY(vect); tn; i++, tn = NEXT(tn) )
         *rp = vect;        vb[i] = (pointer)BDY(tn);
     }
     *rp = vect;
 }  }
   
 void Pnewmat(arg,rp)  void Pvect(NODE arg,VECT *rp) {
 NODE arg;    int len,i;
 MAT *rp;    VECT vect;
     pointer *vb;
     NODE tn;
   
     if ( !arg ) {
       *rp =0;
       return;
     }
   
     for (len = 0, tn = arg; tn; tn = NEXT(tn), len++);
     if ( len == 1 ) {
       if ( ARG0(arg) != 0 ) {
         switch ( OID(ARG0(arg)) ) {
           case O_VECT:
             *rp = ARG0(arg);
             return;
           case O_LIST:
             for ( len = 0, tn = ARG0(arg); tn; tn = NEXT(tn), len++ );
             MKVECT(vect,len-1);
             for ( i = 0, tn = BDY((LIST)ARG0(arg)), vb =BDY(vect);
                 tn; i++, tn = NEXT(tn) )
               vb[i] = (pointer)BDY(tn);
             *rp=vect;
             return;
         }
       }
     }
     MKVECT(vect,len);
     for ( i = 0, tn = arg, vb = BDY(vect); tn; i++, tn = NEXT(tn) )
       vb[i] = (pointer)BDY(tn);
     *rp = vect;
   }
   
   void Pexponent_vector(NODE arg,DP *rp)
 {  {
         int row,col;    nodetod(arg,rp);
         int i,j,r,c;  }
         NODE tn,sn;  
         MAT m;  
         pointer **mb;  
         LIST list;  
   
         asir_assert(ARG0(arg),O_N,"newmat");  void Pnewbytearray(NODE arg,BYTEARRAY *rp)
         asir_assert(ARG1(arg),O_N,"newmat");  {
         row = QTOS((Q)ARG0(arg)); col = QTOS((Q)ARG1(arg));    int len,i,r;
         if ( row <= 0 || col <= 0 )    BYTEARRAY array;
                 error("newmat : invalid size");    unsigned char *vb;
         MKMAT(m,row,col);    char *str;
         if ( argc(arg) == 3 ) {    LIST list;
                 list = (LIST)ARG2(arg);    NODE tn;
                 asir_assert(list,O_LIST,"newmat");    int ac;
                 for ( r = 0, c = 0, tn = BDY(list); tn; r++, tn = NEXT(tn) ) {    struct stat sbuf;
                         for ( j = 0, sn = BDY((LIST)BDY(tn)); sn; j++, sn = NEXT(sn) );    char *fname;
                         c = MAX(c,j);    FILE *fp;
                 }  
                 if ( (r > row) || (c > col) ) {    ac = argc(arg);
                         *rp = m;    if ( ac == 1 ) {
                         return;      if ( !OID((Obj)ARG0(arg)) ) error("newbytearray : invalid argument");
                 }      switch ( OID((Obj)ARG0(arg)) ) {
                 for ( i = 0, tn = BDY(list), mb = BDY(m); tn; i++, tn = NEXT(tn) ) {        case O_STR:
                         asir_assert(BDY(tn),O_LIST,"newmat");          fname = BDY((STRING)ARG0(arg));
                         for ( j = 0, sn = BDY((LIST)BDY(tn)); sn; j++, sn = NEXT(sn) )          fp = fopen(fname,"rb");
                                 mb[i][j] = (pointer)BDY(sn);          if ( !fp ) error("newbytearray : fopen failed");
                 }          if ( stat(fname,&sbuf) < 0 )
         }            error("newbytearray : stat failed");
         *rp = m;          len = sbuf.st_size;
           MKBYTEARRAY(array,len);
           fread(BDY(array),len,sizeof(char),fp);
           break;
         case O_N:
           if ( !RATN(ARG0(arg)) )
             error("newbytearray : invalid argument");
           len = QTOS((Q)ARG0(arg));
           if ( len < 0 )
             error("newbytearray : invalid size");
           MKBYTEARRAY(array,len);
           break;
         default:
           error("newbytearray : invalid argument");
       }
     } else if ( ac == 2 ) {
       asir_assert(ARG0(arg),O_N,"newbytearray");
       len = QTOS((Q)ARG0(arg));
       if ( len < 0 )
         error("newbytearray : invalid size");
       MKBYTEARRAY(array,len);
       if ( !ARG1(arg) )
         error("newbytearray : invalid initialization");
       switch ( OID((Obj)ARG1(arg)) ) {
         case O_LIST:
           list = (LIST)ARG1(arg);
           asir_assert(list,O_LIST,"newbytearray");
           for ( r = 0, tn = BDY(list); tn; r++, tn = NEXT(tn) );
           if ( r <= len ) {
             for ( i = 0, tn = BDY(list), vb = BDY(array); tn;
               i++, tn = NEXT(tn) )
               vb[i] = (unsigned char)QTOS((Q)BDY(tn));
           }
           break;
         case O_STR:
           str = BDY((STRING)ARG1(arg));
           r = strlen(str);
           if ( r <= len )
             bcopy(str,BDY(array),r);
           break;
         default:
           if ( !ARG1(arg) )
             error("newbytearray : invalid initialization");
       }
     } else
       error("newbytearray : invalid argument");
     *rp = array;
 }  }
   
 void Pvtol(arg,rp)  #define MEMORY_GETPOINT(a,len,x,y) (((a)[(len)*(y)+((x)>>3)])&(1<<((x)&7)))
 NODE arg;  
 LIST *rp;  void Pmemoryplot_to_coord(NODE arg,LIST *rp)
 {  {
         NODE n,n1;    int len,blen,y,i,j;
         VECT v;    unsigned char *a;
         pointer *a;    NODE r0,r,n;
         int len,i;    LIST l;
     BYTEARRAY ba;
     Q iq,jq;
   
         asir_assert(ARG0(arg),O_VECT,"vtol");    asir_assert(ARG0(arg),O_LIST,"memoryplot_to_coord");
         v = (VECT)ARG0(arg); len = v->len; a = BDY(v);    arg = BDY((LIST)ARG0(arg));
         for ( i = len - 1, n = 0; i >= 0; i-- ) {    len = QTOS((Q)ARG0(arg));
                 MKNODE(n1,a[i],n); n = n1;    blen = (len+7)/8;
         }    y = QTOS((Q)ARG1(arg));
         MKLIST(*rp,n);    ba = (BYTEARRAY)ARG2(arg); a = ba->body;
     r0 = 0;
     for ( j = 0; j < y; j++ )
       for ( i = 0; i < len; i++ )
         if ( MEMORY_GETPOINT(a,blen,i,j) ) {
           NEXTNODE(r0,r);
           STOQ(i,iq); STOQ(j,jq);
           n = mknode(2,iq,jq);
           MKLIST(l,n);
           BDY(r) = l;
         }
     if ( r0 ) NEXT(r) = 0;
     MKLIST(*rp,r0);
 }  }
   
 void Premainder(arg,rp)  void Pnewmat(NODE arg,MAT *rp)
 NODE arg;  
 Obj *rp;  
 {  {
         Obj a;    int row,col;
         VECT v,w;    int i,j,r,c;
         MAT m,l;    NODE tn,sn;
         pointer *vb,*wb;    MAT m;
         pointer **mb,**lb;    pointer **mb;
         int id,i,j,n,row,col,t,smd,sgn;    LIST list;
         Q md,q;  
   
         a = (Obj)ARG0(arg); md = (Q)ARG1(arg);    asir_assert(ARG0(arg),O_N,"newmat");
         if ( !a )    asir_assert(ARG1(arg),O_N,"newmat");
                 *rp = 0;    row = QTOS((Q)ARG0(arg)); col = QTOS((Q)ARG1(arg));
         else {    if ( row < 0 || col < 0 )
                 id = OID(a);      error("newmat : invalid size");
                 switch ( id ) {    MKMAT(m,row,col);
                         case O_N:    if ( argc(arg) == 3 ) {
                         case O_P:      list = (LIST)ARG2(arg);
                                 cmp(md,(P)a,(P *)rp); break;      asir_assert(list,O_LIST,"newmat");
                         case O_VECT:      for ( r = 0, c = 0, tn = BDY(list); tn; r++, tn = NEXT(tn) ) {
                                 smd = QTOS(md);        for ( j = 0, sn = BDY((LIST)BDY(tn)); sn; j++, sn = NEXT(sn) );
                                 v = (VECT)a; n = v->len; vb = v->body;        c = MAX(c,j);
                                 MKVECT(w,n); wb = w->body;      }
                                 for ( i = 0; i < n; i++ ) {      if ( (r > row) || (c > col) ) {
                                         if ( q = (Q)vb[i] ) {        *rp = m;
                                                 sgn = SGN(q); t = rem(NM(q),smd);        return;
                                                 STOQ(t,q);      }
                                                 if ( q )      for ( i = 0, tn = BDY(list), mb = BDY(m); tn; i++, tn = NEXT(tn) ) {
                                                         SGN(q) = sgn;        asir_assert(BDY(tn),O_LIST,"newmat");
                                         }        for ( j = 0, sn = BDY((LIST)BDY(tn)); sn; j++, sn = NEXT(sn) )
                                         wb[i] = (pointer)q;          mb[i][j] = (pointer)BDY(sn);
                                 }      }
                                 *rp = (Obj)w;    }
                                 break;    *rp = m;
                         case O_MAT:  
                                 m = (MAT)a; row = m->row; col = m->col; mb = m->body;  
                                 MKMAT(l,row,col); lb = l->body;  
                                 for ( i = 0; i < row; i++ )  
                                         for ( j = 0, vb = mb[i], wb = lb[i]; j < col; j++ )  
                                                 cmp(md,(P)vb[j],(P *)&wb[j]);  
                                 *rp = (Obj)l;  
                                 break;  
                         default:  
                                 error("remainder : invalid argument");  
                 }  
         }  
 }  }
   
 void Psremainder(arg,rp)  void Pmat(NODE arg, MAT *rp)
 NODE arg;  
 Obj *rp;  
 {  {
         Obj a;    int row,col;
         VECT v,w;    int i;
         MAT m,l;    MAT m;
         pointer *vb,*wb;    pointer **mb;
         pointer **mb,**lb;    pointer *ent;
         unsigned int t,smd;    NODE tn, sn;
         int id,i,j,n,row,col;    VECT v;
         Q md,q;  
   
         a = (Obj)ARG0(arg); md = (Q)ARG1(arg);    if ( !arg ) {
         if ( !a )      *rp =0;
                 *rp = 0;      return;
         else {    }
                 id = OID(a);  
                 switch ( id ) {    for (row = 0, tn = arg; tn; tn = NEXT(tn), row++);
                         case O_N:    if ( row == 1 ) {
                         case O_P:      if ( OID(ARG0(arg)) == O_MAT ) {
                                 cmp(md,(P)a,(P *)rp); break;        *rp=ARG0(arg);
                         case O_VECT:        return;
                                 smd = QTOS(md);      } else if ( !(OID(ARG0(arg)) == O_LIST || OID(ARG0(arg)) == O_VECT)) {
                                 v = (VECT)a; n = v->len; vb = v->body;        error("mat : invalid argument");
                                 MKVECT(w,n); wb = w->body;      }
                                 for ( i = 0; i < n; i++ ) {    }
                                         if ( q = (Q)vb[i] ) {    if ( OID(ARG0(arg)) == O_VECT ) {
                                                 t = (unsigned int)rem(NM(q),smd);      v = ARG0(arg);
                                                 if ( SGN(q) < 0 )      col = v->len;
                                                         t = (smd - t) % smd;    } else if ( OID(ARG0(arg)) == O_LIST ) {
                                                 UTOQ(t,q);      for (col = 0, tn = BDY((LIST)ARG0(arg)); tn ; tn = NEXT(tn), col++);
                                         }    } else {
                                         wb[i] = (pointer)q;      error("mat : invalid argument");
                                 }    }
                                 *rp = (Obj)w;  
                                 break;    MKMAT(m,row,col);
                         case O_MAT:    for (row = 0, tn = arg, mb = BDY(m); tn; tn = NEXT(tn), row++) {
                                 m = (MAT)a; row = m->row; col = m->col; mb = m->body;      if ( BDY(tn) == 0 ) {
                                 MKMAT(l,row,col); lb = l->body;        error("mat : invalid argument");
                                 for ( i = 0; i < row; i++ )      } else if ( OID(BDY(tn)) == O_VECT ) {
                                         for ( j = 0, vb = mb[i], wb = lb[i]; j < col; j++ )        v = tn->body;
                                                 cmp(md,(P)vb[j],(P *)&wb[j]);        ent = BDY(v);
                                 *rp = (Obj)l;        for (i = 0; i < v->len; i++ ) mb[row][i] = (Obj)ent[i];
                                 break;      } else if ( OID(BDY(tn)) == O_LIST ) {
                         default:        for (col = 0, sn = BDY((LIST)BDY(tn)); sn; col++, sn = NEXT(sn) )
                                 error("remainder : invalid argument");          mb[row][col] = (pointer)BDY(sn);
                 }      } else {
         }        error("mat : invalid argument");
       }
     }
     *rp = m;
 }  }
   
 void Psize(arg,rp)  void Pmatc(NODE arg, MAT *rp)
 NODE arg;  
 LIST *rp;  
 {  {
     int row,col;
     int i;
     MAT m;
     pointer **mb;
     pointer *ent;
     NODE tn, sn;
     VECT v;
   
         int n,m;    if ( !arg ) {
         Q q;      *rp =0;
         NODE t,s;      return;
     }
   
         if ( !ARG0(arg) )    for (col = 0, tn = arg; tn; tn = NEXT(tn), col++);
                  t = 0;    if ( col == 1 ) {
         else {      if ( OID(ARG0(arg)) == O_MAT ) {
                 switch (OID(ARG0(arg))) {        *rp=ARG0(arg);
                         case O_VECT:        return;
                                 n = ((VECT)ARG0(arg))->len;      } else if ( !(OID(ARG0(arg)) == O_LIST || OID(ARG0(arg)) == O_VECT)) {
                                 STOQ(n,q); MKNODE(t,q,0);        error("matc : invalid argument");
                                 break;      }
                         case O_MAT:    }
                                 n = ((MAT)ARG0(arg))->row; m = ((MAT)ARG0(arg))->col;    if ( OID(ARG0(arg)) == O_VECT ) {
                                 STOQ(m,q); MKNODE(s,q,0); STOQ(n,q); MKNODE(t,q,s);      v = ARG0(arg);
                                 break;      row = v->len;
                         default:    } else if ( OID(ARG0(arg)) == O_LIST ) {
                                 error("size : invalid argument"); break;      for (row = 0, tn = BDY((LIST)ARG0(arg)); tn ; tn = NEXT(tn), row++);
                 }    } else {
         }      error("matc : invalid argument");
         MKLIST(*rp,t);    }
   
     MKMAT(m,row,col);
     for (col = 0, tn = arg, mb = BDY(m); tn; tn = NEXT(tn), col++) {
       if ( BDY(tn) == 0 ) {
         error("matc : invalid argument");
       } else if ( OID(BDY(tn)) == O_VECT ) {
         v = tn->body;
         ent = BDY(v);
         for (i = 0; i < v->len; i++ ) mb[i][col] = (Obj)ent[i];
       } else if ( OID(BDY(tn)) == O_LIST ) {
         for (row = 0, sn = BDY((LIST)BDY(tn)); sn; row++, sn = NEXT(sn) )
           mb[row][col] = (pointer)BDY(sn);
       } else {
         error("matc : invalid argument");
       }
     }
     *rp = m;
 }  }
   
 void Pdet(arg,rp)  void Pvtol(NODE arg,LIST *rp)
 NODE arg;  
 P *rp;  
 {  {
         MAT m;    NODE n,n1;
         int n,i,j,mod;    VECT v;
         P d;    pointer *a;
         P **mat,**w;    int len,i;
   
         m = (MAT)ARG0(arg);    if ( OID(ARG0(arg)) == O_LIST ) {
         asir_assert(m,O_MAT,"det");      *rp = ARG0(arg);
         if ( m->row != m->col )      return;
                 error("det : non-square matrix");    }
         else if ( argc(arg) == 1 )    asir_assert(ARG0(arg),O_VECT,"vtol");
                 detp(CO,(P **)BDY(m),m->row,rp);    v = (VECT)ARG0(arg); len = v->len; a = BDY(v);
         else {    for ( i = len - 1, n = 0; i >= 0; i-- ) {
                 n = m->row; mod = QTOS((Q)ARG1(arg)); mat = (P **)BDY(m);      MKNODE(n1,a[i],n); n = n1;
                 w = (P **)almat_pointer(n,n);    }
                 for ( i = 0; i < n; i++ )    MKLIST(*rp,n);
                         for ( j = 0; j < n; j++ )  
                                 ptomp(mod,mat[i][j],&w[i][j]);  
                 detmp(CO,mod,w,n,&d);  
                 mptop(d,rp);  
         }  
 }  }
   
   void Pltov(NODE arg,VECT *rp)
   {
     NODE n;
     VECT v,v0;
     int len,i;
   
     if ( OID(ARG0(arg)) == O_VECT ) {
       v0 = (VECT)ARG0(arg); len = v0->len;
       MKVECT(v,len);
       for ( i = 0; i < len; i++ ) {
         BDY(v)[i] = BDY(v0)[i];
       }
       *rp = v;
       return;
     }
     asir_assert(ARG0(arg),O_LIST,"ltov");
     n = (NODE)BDY((LIST)ARG0(arg));
     len = length(n);
     MKVECT(v,len);
     for ( i = 0; i < len; i++, n = NEXT(n) )
       BDY(v)[i] = BDY(n);
     *rp = v;
   }
   
   void Premainder(NODE arg,Obj *rp)
   {
     Obj a;
     VECT v,w;
     MAT m,l;
     pointer *vb,*wb;
     pointer **mb,**lb;
     int id,i,j,n,row,col,t,smd,sgn;
     Q md,q;
   
     a = (Obj)ARG0(arg); md = (Q)ARG1(arg);
     if ( !a )
       *rp = 0;
     else {
       id = OID(a);
       switch ( id ) {
         case O_N:
         case O_P:
           cmp(md,(P)a,(P *)rp); break;
         case O_VECT:
           smd = QTOS(md);
           v = (VECT)a; n = v->len; vb = v->body;
           MKVECT(w,n); wb = w->body;
           for ( i = 0; i < n; i++ ) {
             if ( q = (Q)vb[i] ) {
               sgn = SGN(q); t = rem(NM(q),smd);
               STOQ(t,q);
               if ( q )
                 SGN(q) = sgn;
             }
             wb[i] = (pointer)q;
           }
           *rp = (Obj)w;
           break;
         case O_MAT:
           m = (MAT)a; row = m->row; col = m->col; mb = m->body;
           MKMAT(l,row,col); lb = l->body;
           for ( i = 0; i < row; i++ )
             for ( j = 0, vb = mb[i], wb = lb[i]; j < col; j++ )
               cmp(md,(P)vb[j],(P *)&wb[j]);
           *rp = (Obj)l;
           break;
         default:
           error("remainder : invalid argument");
       }
     }
   }
   
   void Psremainder(NODE arg,Obj *rp)
   {
     Obj a;
     VECT v,w;
     MAT m,l;
     pointer *vb,*wb;
     pointer **mb,**lb;
     unsigned int t,smd;
     int id,i,j,n,row,col;
     Q md,q;
   
     a = (Obj)ARG0(arg); md = (Q)ARG1(arg);
     if ( !a )
       *rp = 0;
     else {
       id = OID(a);
       switch ( id ) {
         case O_N:
         case O_P:
           cmp(md,(P)a,(P *)rp); break;
         case O_VECT:
           smd = QTOS(md);
           v = (VECT)a; n = v->len; vb = v->body;
           MKVECT(w,n); wb = w->body;
           for ( i = 0; i < n; i++ ) {
             if ( q = (Q)vb[i] ) {
               t = (unsigned int)rem(NM(q),smd);
               if ( SGN(q) < 0 )
                 t = (smd - t) % smd;
               UTOQ(t,q);
             }
             wb[i] = (pointer)q;
           }
           *rp = (Obj)w;
           break;
         case O_MAT:
           m = (MAT)a; row = m->row; col = m->col; mb = m->body;
           MKMAT(l,row,col); lb = l->body;
           for ( i = 0; i < row; i++ )
             for ( j = 0, vb = mb[i], wb = lb[i]; j < col; j++ )
               cmp(md,(P)vb[j],(P *)&wb[j]);
           *rp = (Obj)l;
           break;
         default:
           error("remainder : invalid argument");
       }
     }
   }
   
   void Psize(NODE arg,LIST *rp)
   {
   
     int n,m;
     Q q;
     NODE t,s;
   
     if ( !ARG0(arg) )
        t = 0;
     else {
       switch (OID(ARG0(arg))) {
         case O_VECT:
           n = ((VECT)ARG0(arg))->len;
           STOQ(n,q); MKNODE(t,q,0);
           break;
         case O_MAT:
           n = ((MAT)ARG0(arg))->row; m = ((MAT)ARG0(arg))->col;
           STOQ(m,q); MKNODE(s,q,0); STOQ(n,q); MKNODE(t,q,s);
           break;
         case O_IMAT:
           n = ((IMAT)ARG0(arg))->row; m = ((IMAT)ARG0(arg))->col;
           STOQ(m,q); MKNODE(s,q,0); STOQ(n,q); MKNODE(t,q,s);
           break;
         default:
           error("size : invalid argument"); break;
       }
     }
     MKLIST(*rp,t);
   }
   
   void Pdet(NODE arg,P *rp)
   {
     MAT m;
     int n,i,j,mod;
     P d;
     P **mat,**w;
   
     m = (MAT)ARG0(arg);
     asir_assert(m,O_MAT,"det");
     if ( m->row != m->col )
       error("det : non-square matrix");
     else if ( argc(arg) == 1 )
       detp(CO,(P **)BDY(m),m->row,rp);
     else {
       n = m->row; mod = QTOS((Q)ARG1(arg)); mat = (P **)BDY(m);
       w = (P **)almat_pointer(n,n);
       for ( i = 0; i < n; i++ )
         for ( j = 0; j < n; j++ )
           ptomp(mod,mat[i][j],&w[i][j]);
       detmp(CO,mod,w,n,&d);
       mptop(d,rp);
     }
   }
   
   void Pinvmat(NODE arg,LIST *rp)
   {
     MAT m,r;
     int n,i,j,mod;
     P dn;
     P **mat,**imat,**w;
     NODE nd;
   
     m = (MAT)ARG0(arg);
     asir_assert(m,O_MAT,"invmat");
     if ( m->row != m->col )
       error("invmat : non-square matrix");
     else if ( argc(arg) == 1 ) {
       n = m->row;
       invmatp(CO,(P **)BDY(m),n,&imat,&dn);
       NEWMAT(r); r->row = n; r->col = n; r->body = (pointer **)imat;
       nd = mknode(2,r,dn);
       MKLIST(*rp,nd);
     } else {
       n = m->row; mod = QTOS((Q)ARG1(arg)); mat = (P **)BDY(m);
       w = (P **)almat_pointer(n,n);
       for ( i = 0; i < n; i++ )
         for ( j = 0; j < n; j++ )
           ptomp(mod,mat[i][j],&w[i][j]);
   #if 0
       detmp(CO,mod,w,n,&d);
       mptop(d,rp);
   #else
       error("not implemented yet");
   #endif
     }
   }
   
 /*  /*
         input : a row x col matrix A    input : a row x col matrix A
                 A[I] <-> A[I][0]*x_0+A[I][1]*x_1+...      A[I] <-> A[I][0]*x_0+A[I][1]*x_1+...
   
         output : [B,R,C]    output : [B,D,R,C]
                 B : a rank(A) x col-rank(A) matrix      B : a rank(A) x col-rank(A) matrix
                 R : a vector of length rank(A)      D : the denominator
                 C : a vector of length col-rank(A)      R : a vector of length rank(A)
                 B[I] <-> x_{R[I]}+B[I][0]x_{C[0]}+B[I][1]x_{C[1]}+...      C : a vector of length col-rank(A)
       B[I] <-> D*x_{R[I]}+B[I][0]x_{C[0]}+B[I][1]x_{C[1]}+...
 */  */
   
 void Pgeneric_gauss_elim_mod(arg,rp)  void Pgeneric_gauss_elim(NODE arg,LIST *rp)
 NODE arg;  
 LIST *rp;  
 {  {
         NODE n0;    NODE n0,opt,p;
         MAT m,mat;    MAT m,nm;
         VECT rind,cind;    int *ri,*ci;
         Q **tmat;    VECT rind,cind;
         int **wmat;    Q dn,q;
         Q *rib,*cib;    int i,row,col,t,rank;
         int *colstat;    int is_hensel = 0;
         Q q;    char *key;
         int md,i,j,k,l,row,col,t,n,rank;    Obj value;
   
         asir_assert(ARG0(arg),O_MAT,"generic_gauss_elim_mod");    if ( current_option ) {
         asir_assert(ARG1(arg),O_N,"generic_gauss_elim_mod");      for ( opt = current_option; opt; opt = NEXT(opt) ) {
         m = (MAT)ARG0(arg); md = QTOS((Q)ARG1(arg));        p = BDY((LIST)BDY(opt));
         row = m->row; col = m->col; tmat = (Q **)m->body;        key = BDY((STRING)BDY(p));
         wmat = (int **)almat(row,col);        value = (Obj)BDY(NEXT(p));
         colstat = (int *)MALLOC_ATOMIC(col*sizeof(int));        if ( !strcmp(key,"hensel") && value ) {
         for ( i = 0; i < row; i++ )          is_hensel = value ? 1 : 0;
                 for ( j = 0; j < col; j++ )          break;
                         if ( q = (Q)tmat[i][j] ) {        }
                                 t = rem(NM(q),md);      }
                                 if ( t && SGN(q) < 0 )    }
                                         t = (md - t) % md;    asir_assert(ARG0(arg),O_MAT,"generic_gauss_elim");
                                 wmat[i][j] = t;    m = (MAT)ARG0(arg);
                         } else    row = m->row; col = m->col;
                                 wmat[i][j] = 0;    if ( is_hensel )
         rank = generic_gauss_elim_mod(wmat,row,col,md,colstat);      rank = generic_gauss_elim_hensel(m,&nm,&dn,&ri,&ci);
     else
       rank = generic_gauss_elim(m,&nm,&dn,&ri,&ci);
     t = col-rank;
     MKVECT(rind,rank);
     MKVECT(cind,t);
     for ( i = 0; i < rank; i++ ) {
       STOQ(ri[i],q);
       BDY(rind)[i] = (pointer)q;
     }
     for ( i = 0; i < t; i++ ) {
       STOQ(ci[i],q);
       BDY(cind)[i] = (pointer)q;
     }
     n0 = mknode(4,nm,dn,rind,cind);
     MKLIST(*rp,n0);
   }
   
         MKMAT(mat,rank,col-rank);  void Pindep_rows_mod(NODE arg,VECT *rp)
         tmat = (Q **)mat->body;  {
         for ( i = 0; i < rank; i++ )    MAT m,mat;
                 for ( j = k = 0; j < col; j++ )    VECT rind;
                         if ( !colstat[j] ) {    Q **tmat;
                                 UTOQ(wmat[i][j],tmat[i][k]); k++;    int **wmat,**row0;
                         }    Q *rib;
     int *rowstat,*p;
     Q q;
     int md,i,j,k,l,row,col,t,rank;
   
         MKVECT(rind,rank);    asir_assert(ARG0(arg),O_MAT,"indep_rows_mod");
         MKVECT(cind,col-rank);    asir_assert(ARG1(arg),O_N,"indep_rows_mod");
         rib = (Q *)rind->body; cib = (Q *)cind->body;    m = (MAT)ARG0(arg); md = QTOS((Q)ARG1(arg));
         for ( j = k = l = 0; j < col; j++ )    row = m->row; col = m->col; tmat = (Q **)m->body;
                 if ( colstat[j] ) {    wmat = (int **)almat(row,col);
                         STOQ(j,rib[k]); k++;  
                 } else {    row0 = (int **)ALLOCA(row*sizeof(int *));
                         STOQ(j,cib[l]); l++;    for ( i = 0; i < row; i++ ) row0[i] = wmat[i];
                 }  
         n0 = mknode(3,mat,rind,cind);    rowstat = (int *)MALLOC_ATOMIC(row*sizeof(int));
         MKLIST(*rp,n0);    for ( i = 0; i < row; i++ )
       for ( j = 0; j < col; j++ )
         if ( q = (Q)tmat[i][j] ) {
           t = rem(NM(q),md);
           if ( t && SGN(q) < 0 )
             t = (md - t) % md;
           wmat[i][j] = t;
         } else
           wmat[i][j] = 0;
     rank = indep_rows_mod(wmat,row,col,md,rowstat);
   
     MKVECT(rind,rank);
     rib = (Q *)rind->body;
     for ( j = 0; j < rank; j++ ) {
       STOQ(rowstat[j],rib[j]);
     }
       *rp = rind;
 }  }
   
 void Pleqm(arg,rp)  /*
 NODE arg;    input : a row x col matrix A
 VECT *rp;      A[I] <-> A[I][0]*x_0+A[I][1]*x_1+...
   
     output : [B,R,C]
       B : a rank(A) x col-rank(A) matrix
       R : a vector of length rank(A)
       C : a vector of length col-rank(A)
       RN : a vector of length rank(A) indicating useful rows
   
       B[I] <-> x_{R[I]}+B[I][0]x_{C[0]}+B[I][1]x_{C[1]}+...
   */
   
   void Pgeneric_gauss_elim_mod(NODE arg,LIST *rp)
 {  {
         MAT m;    NODE n0;
         VECT vect;    MAT m,mat;
         pointer **mat;    VECT rind,cind,rnum;
         Q *v;    Q **tmat;
         Q q;    int **wmat,**row0;
         int **wmat;    Q *rib,*cib,*rnb;
         int md,i,j,row,col,t,n,status;    int *colstat,*p;
     Q q;
     int md,i,j,k,l,row,col,t,rank;
   
         asir_assert(ARG0(arg),O_MAT,"leqm");    asir_assert(ARG0(arg),O_MAT,"generic_gauss_elim_mod");
         asir_assert(ARG1(arg),O_N,"leqm");    asir_assert(ARG1(arg),O_N,"generic_gauss_elim_mod");
         m = (MAT)ARG0(arg); md = QTOS((Q)ARG1(arg));    m = (MAT)ARG0(arg); md = QTOS((Q)ARG1(arg));
         row = m->row; col = m->col; mat = m->body;    row = m->row; col = m->col; tmat = (Q **)m->body;
         wmat = (int **)almat(row,col);    wmat = (int **)almat(row,col);
         for ( i = 0; i < row; i++ )  
                 for ( j = 0; j < col; j++ )    row0 = (int **)ALLOCA(row*sizeof(int *));
                         if ( q = (Q)mat[i][j] ) {    for ( i = 0; i < row; i++ ) row0[i] = wmat[i];
                                 t = rem(NM(q),md);  
                                 if ( SGN(q) < 0 )    colstat = (int *)MALLOC_ATOMIC(col*sizeof(int));
                                         t = (md - t) % md;    for ( i = 0; i < row; i++ )
                                 wmat[i][j] = t;      for ( j = 0; j < col; j++ )
                         } else        if ( q = (Q)tmat[i][j] ) {
                                 wmat[i][j] = 0;          t = rem(NM(q),md);
         status = gauss_elim_mod(wmat,row,col,md);          if ( t && SGN(q) < 0 )
         if ( status < 0 )            t = (md - t) % md;
                 *rp = 0;          wmat[i][j] = t;
         else if ( status > 0 )        } else
                 *rp = (VECT)ONE;          wmat[i][j] = 0;
         else {    rank = generic_gauss_elim_mod(wmat,row,col,md,colstat);
                 n = col - 1;  
                 MKVECT(vect,n);    MKVECT(rnum,rank);
                 for ( i = 0, v = (Q *)vect->body; i < n; i++ ) {    rnb = (Q *)rnum->body;
                         t = (md-wmat[i][n])%md; STOQ(t,v[i]);    for ( i = 0; i < rank; i++ )
                 }      for ( j = 0, p = wmat[i]; j < row; j++ )
                 *rp = vect;        if ( p == row0[j] )
         }          STOQ(j,rnb[i]);
   
     MKMAT(mat,rank,col-rank);
     tmat = (Q **)mat->body;
     for ( i = 0; i < rank; i++ )
       for ( j = k = 0; j < col; j++ )
         if ( !colstat[j] ) {
           UTOQ(wmat[i][j],tmat[i][k]); k++;
         }
   
     MKVECT(rind,rank);
     MKVECT(cind,col-rank);
     rib = (Q *)rind->body; cib = (Q *)cind->body;
     for ( j = k = l = 0; j < col; j++ )
       if ( colstat[j] ) {
         STOQ(j,rib[k]); k++;
       } else {
         STOQ(j,cib[l]); l++;
       }
     n0 = mknode(4,mat,rind,cind,rnum);
     MKLIST(*rp,n0);
 }  }
   
 int gauss_elim_mod(mat,row,col,md)  void Pleqm(NODE arg,VECT *rp)
 int **mat;  
 int row,col,md;  
 {  {
         int i,j,k,inv,a,n;    MAT m;
         int *t,*pivot;    VECT vect;
     pointer **mat;
     Q *v;
     Q q;
     int **wmat;
     int md,i,j,row,col,t,n,status;
   
         n = col - 1;    asir_assert(ARG0(arg),O_MAT,"leqm");
         for ( j = 0; j < n; j++ ) {    asir_assert(ARG1(arg),O_N,"leqm");
                 for ( i = j; i < row && !mat[i][j]; i++ );    m = (MAT)ARG0(arg); md = QTOS((Q)ARG1(arg));
                 if ( i == row )    row = m->row; col = m->col; mat = m->body;
                         return 1;    wmat = (int **)almat(row,col);
                 if ( i != j ) {    for ( i = 0; i < row; i++ )
                         t = mat[i]; mat[i] = mat[j]; mat[j] = t;      for ( j = 0; j < col; j++ )
                 }        if ( q = (Q)mat[i][j] ) {
                 pivot = mat[j];          t = rem(NM(q),md);
                 inv = invm(pivot[j],md);          if ( SGN(q) < 0 )
                 for ( k = j; k <= n; k++ ) {            t = (md - t) % md;
 /*                      pivot[k] = dmar(pivot[k],inv,0,md); */          wmat[i][j] = t;
                         DMAR(pivot[k],inv,0,md,pivot[k])        } else
                 }          wmat[i][j] = 0;
                 for ( i = 0; i < row; i++ ) {    status = gauss_elim_mod(wmat,row,col,md);
                         t = mat[i];    if ( status < 0 )
                         if ( i != j && (a = t[j]) )      *rp = 0;
                                 for ( k = j, a = md - a; k <= n; k++ ) {    else if ( status > 0 )
 /*                                      t[k] = dmar(pivot[k],a,t[k],md); */      *rp = (VECT)ONE;
                                         DMAR(pivot[k],a,t[k],md,t[k])    else {
                                 }      n = col - 1;
                 }      MKVECT(vect,n);
         }      for ( i = 0, v = (Q *)vect->body; i < n; i++ ) {
         for ( i = n; i < row && !mat[i][n]; i++ );        t = (md-wmat[i][n])%md; STOQ(t,v[i]);
         if ( i == row )      }
                 return 0;      *rp = vect;
         else    }
                 return -1;  
 }  }
   
 struct oEGT eg_mod,eg_elim,eg_chrem,eg_gschk,eg_intrat,eg_symb;  int gauss_elim_mod(int **mat,int row,int col,int md)
   {
     int i,j,k,inv,a,n;
     int *t,*pivot;
   
 int generic_gauss_elim(mat,nm,dn,rindp,cindp)    n = col - 1;
 MAT mat;    for ( j = 0; j < n; j++ ) {
 MAT *nm;      for ( i = j; i < row && !mat[i][j]; i++ );
 Q *dn;      if ( i == row )
 int **rindp,**cindp;        return 1;
       if ( i != j ) {
         t = mat[i]; mat[i] = mat[j]; mat[j] = t;
       }
       pivot = mat[j];
       inv = invm(pivot[j],md);
       for ( k = j; k <= n; k++ ) {
   /*      pivot[k] = dmar(pivot[k],inv,0,md); */
         DMAR(pivot[k],inv,0,md,pivot[k])
       }
       for ( i = 0; i < row; i++ ) {
         t = mat[i];
         if ( i != j && (a = t[j]) )
           for ( k = j, a = md - a; k <= n; k++ ) {
             unsigned int tk;
   /*          t[k] = dmar(pivot[k],a,t[k],md); */
             DMAR(pivot[k],a,t[k],md,tk)
             t[k] = tk;
           }
       }
     }
     for ( i = n; i < row && !mat[i][n]; i++ );
     if ( i == row )
       return 0;
     else
       return -1;
   }
   
   struct oEGT eg_mod,eg_elim,eg_elim1,eg_elim2,eg_chrem,eg_gschk,eg_intrat,eg_symb;
   struct oEGT eg_conv;
   
   int generic_gauss_elim(MAT mat,MAT *nm,Q *dn,int **rindp,int **cindp)
 {  {
         int **wmat;    int **wmat;
         Q **bmat;    Q **bmat;
         N **tmat;    N **tmat;
         Q *bmi;    Q *bmi;
         N *tmi;    N *tmi;
         Q q;    Q q;
         int *wmi;    int *wmi;
         int *colstat,*wcolstat,*rind,*cind;    int *colstat,*wcolstat,*rind,*cind;
         int row,col,ind,md,i,j,k,l,t,t1,rank,rank0,inv;    int row,col,ind,md,i,j,k,l,t,t1,rank,rank0,inv;
         N m1,m2,m3,s,u;    N m1,m2,m3,s,u;
         MAT r,crmat;    MAT r,crmat;
         struct oEGT tmp0,tmp1;    struct oEGT tmp0,tmp1;
         struct oEGT eg_mod_split,eg_elim_split,eg_chrem_split;    struct oEGT eg_mod_split,eg_elim_split,eg_chrem_split;
         struct oEGT eg_intrat_split,eg_gschk_split;    struct oEGT eg_intrat_split,eg_gschk_split;
         int ret;    int ret;
   
         init_eg(&eg_mod_split); init_eg(&eg_chrem_split);    init_eg(&eg_mod_split); init_eg(&eg_chrem_split);
         init_eg(&eg_elim_split); init_eg(&eg_intrat_split);    init_eg(&eg_elim_split); init_eg(&eg_intrat_split);
         init_eg(&eg_gschk_split);    init_eg(&eg_gschk_split);
         bmat = (Q **)mat->body;    bmat = (Q **)mat->body;
         row = mat->row; col = mat->col;    row = mat->row; col = mat->col;
         wmat = (int **)almat(row,col);    wmat = (int **)almat(row,col);
         colstat = (int *)MALLOC_ATOMIC(col*sizeof(int));    colstat = (int *)MALLOC_ATOMIC(col*sizeof(int));
         wcolstat = (int *)MALLOC_ATOMIC(col*sizeof(int));    wcolstat = (int *)MALLOC_ATOMIC(col*sizeof(int));
         for ( ind = 0; ; ind++ ) {    for ( ind = 0; ; ind++ ) {
                 if ( Print ) {      if ( DP_Print ) {
                         fprintf(asir_out,"."); fflush(asir_out);        fprintf(asir_out,"."); fflush(asir_out);
                 }      }
                 md = lprime[ind];      md = get_lprime(ind);
                 get_eg(&tmp0);      get_eg(&tmp0);
                 for ( i = 0; i < row; i++ )      for ( i = 0; i < row; i++ )
                         for ( j = 0, bmi = bmat[i], wmi = wmat[i]; j < col; j++ )        for ( j = 0, bmi = bmat[i], wmi = wmat[i]; j < col; j++ )
                                 if ( q = (Q)bmi[j] ) {          if ( q = (Q)bmi[j] ) {
                                         t = rem(NM(q),md);            t = rem(NM(q),md);
                                         if ( t && SGN(q) < 0 )            if ( t && SGN(q) < 0 )
                                                 t = (md - t) % md;              t = (md - t) % md;
                                         wmi[j] = t;            wmi[j] = t;
                                 } else          } else
                                         wmi[j] = 0;            wmi[j] = 0;
                 get_eg(&tmp1);      get_eg(&tmp1);
                 add_eg(&eg_mod,&tmp0,&tmp1);      add_eg(&eg_mod,&tmp0,&tmp1);
                 add_eg(&eg_mod_split,&tmp0,&tmp1);      add_eg(&eg_mod_split,&tmp0,&tmp1);
                 get_eg(&tmp0);      get_eg(&tmp0);
                 rank = generic_gauss_elim_mod(wmat,row,col,md,wcolstat);      rank = generic_gauss_elim_mod(wmat,row,col,md,wcolstat);
                 get_eg(&tmp1);      get_eg(&tmp1);
                 add_eg(&eg_elim,&tmp0,&tmp1);      add_eg(&eg_elim,&tmp0,&tmp1);
                 add_eg(&eg_elim_split,&tmp0,&tmp1);      add_eg(&eg_elim_split,&tmp0,&tmp1);
                 if ( !ind ) {      if ( !ind ) {
 RESET:  RESET:
                         UTON(md,m1);        UTON(md,m1);
                         rank0 = rank;        rank0 = rank;
                         bcopy(wcolstat,colstat,col*sizeof(int));        bcopy(wcolstat,colstat,col*sizeof(int));
                         MKMAT(crmat,rank,col-rank);        MKMAT(crmat,rank,col-rank);
                         MKMAT(r,rank,col-rank); *nm = r;        MKMAT(r,rank,col-rank); *nm = r;
                         tmat = (N **)crmat->body;        tmat = (N **)crmat->body;
                         for ( i = 0; i < rank; i++ )        for ( i = 0; i < rank; i++ )
                                 for ( j = k = 0, tmi = tmat[i], wmi = wmat[i]; j < col; j++ )          for ( j = k = 0, tmi = tmat[i], wmi = wmat[i]; j < col; j++ )
                                         if ( !colstat[j] ) {            if ( !colstat[j] ) {
                                                 UTON(wmi[j],tmi[k]); k++;              UTON(wmi[j],tmi[k]); k++;
                                         }            }
                 } else {      } else {
                         if ( rank < rank0 ) {        if ( rank < rank0 ) {
                                 if ( Print ) {          if ( DP_Print ) {
                                         fprintf(asir_out,"lower rank matrix; continuing...\n");            fprintf(asir_out,"lower rank matrix; continuing...\n");
                                         fflush(asir_out);            fflush(asir_out);
                                 }          }
                                 continue;          continue;
                         } else if ( rank > rank0 ) {        } else if ( rank > rank0 ) {
                                 if ( Print ) {          if ( DP_Print ) {
                                         fprintf(asir_out,"higher rank matrix; resetting...\n");            fprintf(asir_out,"higher rank matrix; resetting...\n");
                                         fflush(asir_out);            fflush(asir_out);
                                 }          }
                                 goto RESET;          goto RESET;
                         } else {        } else {
                                 for ( j = 0; (j<col) && (colstat[j]==wcolstat[j]); j++ );          for ( j = 0; (j<col) && (colstat[j]==wcolstat[j]); j++ );
                                 if ( j < col ) {          if ( j < col ) {
                                         if ( Print ) {            if ( DP_Print ) {
                                                 fprintf(asir_out,"inconsitent colstat; resetting...\n");              fprintf(asir_out,"inconsitent colstat; resetting...\n");
                                                 fflush(asir_out);              fflush(asir_out);
                                         }            }
                                         goto RESET;            goto RESET;
                                 }          }
                         }        }
   
                         get_eg(&tmp0);        get_eg(&tmp0);
                         inv = invm(rem(m1,md),md);        inv = invm(rem(m1,md),md);
                         UTON(md,m2); muln(m1,m2,&m3);        UTON(md,m2); muln(m1,m2,&m3);
                         for ( i = 0; i < rank; i++ )        for ( i = 0; i < rank; i++ )
                                 for ( j = k = 0, tmi = tmat[i], wmi = wmat[i]; j < col; j++ )          for ( j = k = 0, tmi = tmat[i], wmi = wmat[i]; j < col; j++ )
                                         if ( !colstat[j] ) {            if ( !colstat[j] ) {
                                                 if ( tmi[k] ) {              if ( tmi[k] ) {
                                                 /* f3 = f1+m1*(m1 mod m2)^(-1)*(f2 - f1 mod m2) */              /* f3 = f1+m1*(m1 mod m2)^(-1)*(f2 - f1 mod m2) */
                                                         t = rem(tmi[k],md);                t = rem(tmi[k],md);
                                                         if ( wmi[j] >= t )                if ( wmi[j] >= t )
                                                                 t = wmi[j]-t;                  t = wmi[j]-t;
                                                         else                else
                                                                 t = md-(t-wmi[j]);                  t = md-(t-wmi[j]);
                                                         DMAR(t,inv,0,md,t1)                DMAR(t,inv,0,md,t1)
                                                         UTON(t1,u);                UTON(t1,u);
                                                         muln(m1,u,&s);                muln(m1,u,&s);
                                                         addn(tmi[k],s,&u); tmi[k] = u;                addn(tmi[k],s,&u); tmi[k] = u;
                                                 } else if ( wmi[j] ) {              } else if ( wmi[j] ) {
                                                 /* f3 = m1*(m1 mod m2)^(-1)*f2 */              /* f3 = m1*(m1 mod m2)^(-1)*f2 */
                                                         DMAR(wmi[j],inv,0,md,t)                DMAR(wmi[j],inv,0,md,t)
                                                         UTON(t,u);                UTON(t,u);
                                                         muln(m1,u,&s); tmi[k] = s;                muln(m1,u,&s); tmi[k] = s;
                                                 }              }
                                                 k++;              k++;
                                         }            }
                         m1 = m3;        m1 = m3;
                         get_eg(&tmp1);        get_eg(&tmp1);
                         add_eg(&eg_chrem,&tmp0,&tmp1);        add_eg(&eg_chrem,&tmp0,&tmp1);
                         add_eg(&eg_chrem_split,&tmp0,&tmp1);        add_eg(&eg_chrem_split,&tmp0,&tmp1);
   
                         get_eg(&tmp0);        get_eg(&tmp0);
                         ret = intmtoratm(crmat,m1,*nm,dn);        if ( ind % F4_INTRAT_PERIOD )
                         get_eg(&tmp1);          ret = 0;
                         add_eg(&eg_intrat,&tmp0,&tmp1);        else
                         add_eg(&eg_intrat_split,&tmp0,&tmp1);          ret = intmtoratm(crmat,m1,*nm,dn);
                         if ( ret ) {        get_eg(&tmp1);
                                 *rindp = rind = (int *)MALLOC_ATOMIC(rank*sizeof(int));        add_eg(&eg_intrat,&tmp0,&tmp1);
                                 *cindp = cind = (int *)MALLOC_ATOMIC((col-rank)*sizeof(int));        add_eg(&eg_intrat_split,&tmp0,&tmp1);
                                 for ( j = k = l = 0; j < col; j++ )        if ( ret ) {
                                         if ( colstat[j] )          *rindp = rind = (int *)MALLOC_ATOMIC(rank*sizeof(int));
                                                 rind[k++] = j;          *cindp = cind = (int *)MALLOC_ATOMIC((col-rank)*sizeof(int));
                                         else          for ( j = k = l = 0; j < col; j++ )
                                                 cind[l++] = j;            if ( colstat[j] )
                                 get_eg(&tmp0);              rind[k++] = j;
                                 if ( gensolve_check(mat,*nm,*dn,rind,cind) ) {            else
                                         get_eg(&tmp1);              cind[l++] = j;
                                         add_eg(&eg_gschk,&tmp0,&tmp1);          get_eg(&tmp0);
                                         add_eg(&eg_gschk_split,&tmp0,&tmp1);          if ( gensolve_check(mat,*nm,*dn,rind,cind) ) {
                                         if ( Print ) {            get_eg(&tmp1);
                                                 print_eg("Mod",&eg_mod_split);            add_eg(&eg_gschk,&tmp0,&tmp1);
                                                 print_eg("Elim",&eg_elim_split);            add_eg(&eg_gschk_split,&tmp0,&tmp1);
                                                 print_eg("ChRem",&eg_chrem_split);            if ( DP_Print ) {
                                                 print_eg("IntRat",&eg_intrat_split);              print_eg("Mod",&eg_mod_split);
                                                 print_eg("Check",&eg_gschk_split);              print_eg("Elim",&eg_elim_split);
                                                 fflush(asir_out);              print_eg("ChRem",&eg_chrem_split);
                                         }              print_eg("IntRat",&eg_intrat_split);
                                         return rank;              print_eg("Check",&eg_gschk_split);
                                 }              fflush(asir_out);
                         }            }
                 }            return rank;
         }          }
         }
       }
     }
 }  }
   
 int generic_gauss_elim_hensel(mat,nmmat,dn,rindp,cindp)  void lu_dec_cr(MAT mat,MAT lu,Q *dn,int **perm);
 MAT mat;  
 MAT *nmmat;  /* XXX broken */
 Q *dn;  void lu_dec_cr(MAT mat,MAT lu,Q *dn,int **perm)
 int **rindp,**cindp;  
 {  {
         MAT bmat,xmat;    Q **a0,**b;
         Q **a0,**a,**b,**x,**nm;    Q *aiq;
         Q *ai,*bi,*xi;    N **a;
         int row,col;    N *ai;
         int **w;    Q q,q1,dn2,a1,q0,bik;
         int *wi;    MAT m;
         int **wc;    unsigned int md;
         Q mdq,q,s,u;    int n,ind,i,j,rank,t,inv,t1,ret,min,k;
         N tn;    int **w;
         int ind,md,i,j,k,l,li,ri,rank;    int *wi,*rinfo0,*rinfo;
         unsigned int t;    N m1,m2,m3,u,s;
         int *cinfo,*rinfo;  
         int *rind,*cind;  
         int count;  
         struct oEGT eg_mul,eg_inv,tmp0,tmp1;  
   
         a0 = (Q **)mat->body;    a0 = (Q **)mat->body;
         row = mat->row; col = mat->col;    n = mat->row;
         w = (int **)almat(row,col);    if ( n != mat->col )
         for ( ind = 0; ; ind++ ) {      error("lu_dec_cr : non-square matrix");
                 md = lprime[ind];    w = (int **)almat(n,n);
                 STOQ(md,mdq);    MKMAT(m,n,n);
                 for ( i = 0; i < row; i++ )    a = (N **)m->body;
                         for ( j = 0, ai = a0[i], wi = w[i]; j < col; j++ )    UTON(1,m1);
                                 if ( q = (Q)ai[j] ) {    rinfo0 = 0;
                                         t = rem(NM(q),md);    ind = 0;
                                         if ( t && SGN(q) < 0 )    while ( 1 ) {
                                                 t = (md - t) % md;      md = get_lprime(ind);
                                         wi[j] = t;      /* mat mod md */
                                 } else      for ( i = 0; i < n; i++ )
                                         wi[j] = 0;        for ( j = 0, aiq = a0[i], wi = w[i]; j < n; j++ )
           if ( q = aiq[j] ) {
             t = rem(NM(q),md);
             if ( t && SGN(q) < 0 )
               t = (md - t) % md;
             wi[j] = t;
           } else
             wi[j] = 0;
   
                 rank = find_lhs_and_lu_mod(w,row,col,md,&rinfo,&cinfo);      if ( !lu_mod((unsigned int **)w,n,md,&rinfo) ) continue;
                 a = (Q **)almat_pointer(rank,rank); /* lhs mat */      printf("."); fflush(stdout);
                 MKMAT(bmat,rank,col-rank); b = (Q **)bmat->body; /* lhs mat */      if ( !rinfo0 )
                 for ( j = li = ri = 0; j < col; j++ )        *perm = rinfo0 = rinfo;
                         if ( cinfo[j] ) {      else {
                                 /* the column is in lhs */        for ( i = 0; i < n; i++ )
                                 for ( i = 0; i < rank; i++ ) {          if ( rinfo[i] != rinfo0[i] ) break;
                                         w[i][li] = w[i][j];        if ( i < n ) continue;
                                         a[i][li] = a0[rinfo[i]][j];      }
                                 }      if ( UNIN(m1) ) {
                                 li++;        for ( i = 0; i < n; i++ )
                         } else {          for ( j = 0, ai = a[i], wi = w[i]; j < n; j++ ) {
                                 /* the column is in rhs */            UTON(wi[j],u); ai[j] = u;
                                 for ( i = 0; i < rank; i++ )          }
                                         b[i][ri] = a0[rinfo[i]][j];        UTON(md,m1);
                                 ri++;      } else {
                         }        inv = invm(rem(m1,md),md);
         UTON(md,m2); muln(m1,m2,&m3);
         for ( i = 0; i < n; i++ )
           for ( j = 0, ai = a[i], wi = w[i]; j < n; j++ )
             if ( ai[i] ) {
             /* f3 = f1+m1*(m1 mod m2)^(-1)*(f2 - f1 mod m2) */
               t = rem(ai[j],md);
               if ( wi[j] >= t )
                 t = wi[j]-t;
               else
                 t = md-(t-wi[j]);
               DMAR(t,inv,0,md,t1)
               UTON(t1,u);
               muln(m1,u,&s);
               addn(ai[j],s,&u); ai[j] = u;
             } else if ( wi[j] ) {
               /* f3 = m1*(m1 mod m2)^(-1)*f2 */
               DMAR(wi[j],inv,0,md,t)
               UTON(t,u);
               muln(m1,u,&s); ai[j] = s;
             }
         m1 = m3;
       }
       if ( (++ind%8) == 0 ) {
         ret = intmtoratm(m,m1,lu,dn);
         if ( ret ) {
           b = (Q **)lu->body;
           mulq(*dn,*dn,&dn2);
           for ( i = 0; i < n; i++ ) {
             for ( j = 0; j < n; j++ ) {
               q = 0;
               min = MIN(i,j);
               for ( k = 0; k <= min; k++ ) {
                 bik = k==i ? *dn : b[i][k];
                 mulq(bik,b[k][j],&q0);
                 addq(q,q0,&q1); q = q1;
               }
               mulq(a0[rinfo0[i]][j],dn2,&q1);
               if ( cmpq(q,q1) ) break;
             }
             if ( j < n ) break;
           }
           if ( i == n )
             return;
         }
       }
     }
   }
   
                         /* solve Ax+B=0; A: rank x rank, B: rank x ri */  void nmat(N **m,int n)
                         MKMAT(xmat,rank,ri); x = (Q **)(xmat)->body;  {
                         MKMAT(*nmmat,rank,ri); nm = (Q **)(*nmmat)->body;    int i,j;
                         /* use the right part of w as work area */  
                         /* ri = col - rank */  
                         wc = (int **)almat(rank,ri);  
                         for ( i = 0; i < rank; i++ )  
                                 wc[i] = w[i]+rank;  
                         *rindp = rind = (int *)MALLOC_ATOMIC(rank*sizeof(int));  
                         *cindp = cind = (int *)MALLOC_ATOMIC((ri)*sizeof(int));  
   
                         init_eg(&eg_mul); init_eg(&eg_inv);    for ( i = 0; i < n; i++ ) {
                         for ( q = ONE, count = 0; ; count++ ) {      for ( j = 0; j < n; j++ ) {
                                 fprintf(stderr,".");        printn(m[i][j]); printf(" ");
                                 /* wc = -b mod md */      }
                                 for ( i = 0; i < rank; i++ )      printf("\n");
                                         for ( j = 0, bi = b[i], wi = wc[i]; j < ri; j++ )    }
                                                 if ( u = (Q)bi[j] ) {  
                                                         t = rem(NM(u),md);  
                                                         if ( t && SGN(u) > 0 )  
                                                                 t = (md - t) % md;  
                                                         wi[j] = t;  
                                                 } else  
                                                         wi[j] = 0;  
                                 /* wc = A^(-1)wc; wc is normalized */  
                                 get_eg(&tmp0);  
                                 solve_by_lu_mod(w,rank,md,wc,ri);  
                                 get_eg(&tmp1);  
                                 add_eg(&eg_inv,&tmp0,&tmp1);  
                                 /* x = x-q*wc */  
                                 for ( i = 0; i < rank; i++ )  
                                         for ( j = 0, xi = x[i], wi = wc[i]; j < ri; j++ ) {  
                                                 STOQ(wi[j],u); mulq(q,u,&s);  
                                                 subq(xi[j],s,&u); xi[j] = u;  
                                         }  
                                 get_eg(&tmp0);  
                                 for ( i = 0; i < rank; i++ )  
                                         for ( j = 0; j < ri; j++ ) {  
                                                 inner_product_mat_int_mod(a,wc,rank,i,j,&u);  
                                                 addq(b[i][j],u,&s);  
                                                 if ( s ) {  
                                                         t = divin(NM(s),md,&tn);  
                                                         if ( t )  
                                                                 error("generic_gauss_elim_hensel:incosistent");  
                                                         NTOQ(tn,SGN(s),b[i][j]);  
                                                 } else  
                                                         b[i][j] = 0;  
                                         }  
                                 get_eg(&tmp1);  
                                 add_eg(&eg_mul,&tmp0,&tmp1);  
                                 /* q = q*md */  
                                 mulq(q,mdq,&u); q = u;  
                                 if ( !(count % 2) && intmtoratm_q(xmat,NM(q),*nmmat,dn) ) {  
                                         for ( j = k = l = 0; j < col; j++ )  
                                                 if ( cinfo[j] )  
                                                         rind[k++] = j;  
                                                 else  
                                                         cind[l++] = j;  
                                         if ( gensolve_check(mat,*nmmat,*dn,rind,cind) ) {  
                                                 fprintf(stderr,"\n");  
                                                 print_eg("INV",&eg_inv);  
                                                 print_eg("MUL",&eg_mul);  
                                                 fflush(asir_out);  
                                                 return rank;  
                                         }  
                                 }  
                         }  
         }  
 }  }
   
   int generic_gauss_elim_hensel(MAT mat,MAT *nmmat,Q *dn,int **rindp,int **cindp)
   {
     MAT bmat,xmat;
     Q **a0,**a,**b,**x,**nm;
     Q *ai,*bi,*xi;
     int row,col;
     int **w;
     int *wi;
     int **wc;
     Q mdq,q,s,u;
     N tn;
     int ind,md,i,j,k,l,li,ri,rank;
     unsigned int t;
     int *cinfo,*rinfo;
     int *rind,*cind;
     int count;
     int ret;
     struct oEGT eg_mul,eg_inv,eg_intrat,eg_check,tmp0,tmp1;
     int period;
     int *wx,*ptr;
     int wxsize,nsize;
     N wn;
     Q wq;
   
     a0 = (Q **)mat->body;
     row = mat->row; col = mat->col;
     w = (int **)almat(row,col);
     for ( ind = 0; ; ind++ ) {
       md = get_lprime(ind);
       STOQ(md,mdq);
       for ( i = 0; i < row; i++ )
         for ( j = 0, ai = a0[i], wi = w[i]; j < col; j++ )
           if ( q = (Q)ai[j] ) {
             t = rem(NM(q),md);
             if ( t && SGN(q) < 0 )
               t = (md - t) % md;
             wi[j] = t;
           } else
             wi[j] = 0;
   
       if ( DP_Print > 3 ) {
         fprintf(asir_out,"LU decomposition.."); fflush(asir_out);
       }
       rank = find_lhs_and_lu_mod((unsigned int **)w,row,col,md,&rinfo,&cinfo);
       if ( DP_Print > 3 ) {
         fprintf(asir_out,"done.\n"); fflush(asir_out);
       }
       a = (Q **)almat_pointer(rank,rank); /* lhs mat */
       MKMAT(bmat,rank,col-rank); b = (Q **)bmat->body; /* lhs mat */
       for ( j = li = ri = 0; j < col; j++ )
         if ( cinfo[j] ) {
           /* the column is in lhs */
           for ( i = 0; i < rank; i++ ) {
             w[i][li] = w[i][j];
             a[i][li] = a0[rinfo[i]][j];
           }
           li++;
         } else {
           /* the column is in rhs */
           for ( i = 0; i < rank; i++ )
             b[i][ri] = a0[rinfo[i]][j];
           ri++;
         }
   
         /* solve Ax+B=0; A: rank x rank, B: rank x ri */
         MKMAT(xmat,rank,ri); x = (Q **)(xmat)->body;
         MKMAT(*nmmat,rank,ri); nm = (Q **)(*nmmat)->body;
         /* use the right part of w as work area */
         /* ri = col - rank */
         wc = (int **)almat(rank,ri);
         for ( i = 0; i < rank; i++ )
           wc[i] = w[i]+rank;
         *rindp = rind = (int *)MALLOC_ATOMIC(rank*sizeof(int));
         *cindp = cind = (int *)MALLOC_ATOMIC((ri)*sizeof(int));
   
         init_eg(&eg_mul); init_eg(&eg_inv);
         init_eg(&eg_check); init_eg(&eg_intrat);
         period = F4_INTRAT_PERIOD;
         nsize = period;
         wxsize = rank*ri*nsize;
         wx = (int *)MALLOC_ATOMIC(wxsize*sizeof(int));
         for ( i = 0; i < wxsize; i++ ) wx[i] = 0;
         for ( q = ONE, count = 0; ; ) {
           if ( DP_Print > 3 )
             fprintf(stderr,"o");
           /* wc = -b mod md */
           get_eg(&tmp0);
           for ( i = 0; i < rank; i++ )
             for ( j = 0, bi = b[i], wi = wc[i]; j < ri; j++ )
               if ( u = (Q)bi[j] ) {
                 t = rem(NM(u),md);
                 if ( t && SGN(u) > 0 )
                   t = (md - t) % md;
                 wi[j] = t;
               } else
                 wi[j] = 0;
           /* wc = A^(-1)wc; wc is not normalized */
           solve_by_lu_mod(w,rank,md,wc,ri,0);
           /* wx += q*wc */
           ptr = wx;
           for ( i = 0; i < rank; i++ )
             for ( j = 0, wi = wc[i]; j < ri; j++ ) {
               if ( wi[j] )
                 muln_1(BD(NM(q)),PL(NM(q)),wi[j],ptr);
               ptr += nsize;
             }
           count++;
           get_eg(&tmp1);
           add_eg(&eg_inv,&tmp0,&tmp1);
           get_eg(&tmp0);
           for ( i = 0; i < rank; i++ )
             for ( j = 0; j < ri; j++ ) {
               inner_product_mat_int_mod(a,wc,rank,i,j,&u);
               addq(b[i][j],u,&s);
               if ( s ) {
                 t = divin(NM(s),md,&tn);
                 if ( t )
                   error("generic_gauss_elim_hensel:incosistent");
                 NTOQ(tn,SGN(s),b[i][j]);
               } else
                 b[i][j] = 0;
             }
           get_eg(&tmp1);
           add_eg(&eg_mul,&tmp0,&tmp1);
           /* q = q*md */
           mulq(q,mdq,&u); q = u;
           if ( count == period ) {
             get_eg(&tmp0);
             ptr = wx;
             for ( i = 0; i < rank; i++ )
               for ( j = 0, xi = x[i]; j < ri;
                 j++, ptr += nsize ) {
                 for ( k = nsize-1; k >= 0 && !ptr[k]; k-- );
                 if ( k >= 0 ) {
                   wn = NALLOC(k+1);
                   PL(wn) = k+1;
                   for ( l = 0; l <= k; l++ ) BD(wn)[l] = (unsigned int)ptr[l];
                   NTOQ(wn,1,wq);
                   subq(xi[j],wq,&u); xi[j] = u;
                 }
               }
             ret = intmtoratm_q(xmat,NM(q),*nmmat,dn);
             get_eg(&tmp1); add_eg(&eg_intrat,&tmp0,&tmp1);
             if ( ret ) {
               rind = (int *)MALLOC_ATOMIC(rank*sizeof(int));
               cind = (int *)MALLOC_ATOMIC((col-rank)*sizeof(int));
               for ( j = k = l = 0; j < col; j++ )
                 if ( cinfo[j] )
                   rind[k++] = j;
                 else
                   cind[l++] = j;
               get_eg(&tmp0);
               ret = gensolve_check(mat,*nmmat,*dn,rind,cind);
               get_eg(&tmp1); add_eg(&eg_check,&tmp0,&tmp1);
               if ( ret ) {
                 if ( DP_Print > 3 ) {
                   fprintf(stderr,"\n");
                   print_eg("INV",&eg_inv);
                   print_eg("MUL",&eg_mul);
                   print_eg("INTRAT",&eg_intrat);
                   print_eg("CHECK",&eg_check);
                   fflush(asir_out);
                 }
                 *rindp = rind;
                 *cindp = cind;
                 for ( j = k = 0; j < col; j++ )
                   if ( !cinfo[j] )
                     cind[k++] = j;
                 return rank;
               }
             } else {
               period = period*3/2;
               count = 0;
               nsize += period;
               wxsize += rank*ri*nsize;
               wx = (int *)REALLOC(wx,wxsize*sizeof(int));
               for ( i = 0; i < wxsize; i++ ) wx[i] = 0;
             }
           }
         }
     }
   }
   
   int generic_gauss_elim_hensel_dalg(MAT mat,DP *mb,MAT *nmmat,Q *dn,int **rindp,int **cindp)
   {
     MAT bmat,xmat;
     Q **a0,**a,**b,**x,**nm;
     Q *ai,*bi,*xi;
     int row,col;
     int **w;
     int *wi;
     int **wc;
     Q mdq,q,s,u;
     N tn;
     int ind,md,i,j,k,l,li,ri,rank;
     unsigned int t;
     int *cinfo,*rinfo;
     int *rind,*cind;
     int count;
     int ret;
     struct oEGT eg_mul,eg_inv,eg_intrat,eg_check,tmp0,tmp1;
     int period;
     int *wx,*ptr;
     int wxsize,nsize;
     N wn;
     Q wq;
     NumberField nf;
     DP m;
     int col1;
   
     a0 = (Q **)mat->body;
     row = mat->row; col = mat->col;
     w = (int **)almat(row,col);
     for ( ind = 0; ; ind++ ) {
       md = get_lprime(ind);
       STOQ(md,mdq);
       for ( i = 0; i < row; i++ )
         for ( j = 0, ai = a0[i], wi = w[i]; j < col; j++ )
           if ( q = (Q)ai[j] ) {
             t = rem(NM(q),md);
             if ( t && SGN(q) < 0 )
               t = (md - t) % md;
             wi[j] = t;
           } else
             wi[j] = 0;
   
       if ( DP_Print ) {
         fprintf(asir_out,"LU decomposition.."); fflush(asir_out);
       }
       rank = find_lhs_and_lu_mod((unsigned int **)w,row,col,md,&rinfo,&cinfo);
       if ( DP_Print ) {
         fprintf(asir_out,"done.\n"); fflush(asir_out);
       }
       for ( i = 0; i < col-1; i++ ) {
         if ( !cinfo[i] ) {
           m = mb[i];
           for ( j = i+1; j < col-1; j++ )
             if ( dp_redble(mb[j],m) )
               cinfo[j] = -1;
         }
       }
       a = (Q **)almat_pointer(rank,rank); /* lhs mat */
       MKMAT(bmat,rank,col-rank); b = (Q **)bmat->body; /* lhs mat */
       for ( j = li = ri = 0; j < col; j++ )
         if ( cinfo[j] > 0 ) {
           /* the column is in lhs */
           for ( i = 0; i < rank; i++ ) {
             w[i][li] = w[i][j];
             a[i][li] = a0[rinfo[i]][j];
           }
           li++;
         } else if ( !cinfo[j] ) {
           /* the column is in rhs */
           for ( i = 0; i < rank; i++ )
             b[i][ri] = a0[rinfo[i]][j];
           ri++;
         }
   
         /* solve Ax+B=0; A: rank x rank, B: rank x ri */
         MKMAT(xmat,rank,ri); x = (Q **)(xmat)->body;
         MKMAT(*nmmat,rank,ri); nm = (Q **)(*nmmat)->body;
         /* use the right part of w as work area */
         wc = (int **)almat(rank,ri);
         for ( i = 0; i < rank; i++ )
           wc[i] = w[i]+rank;
         *rindp = rind = (int *)MALLOC_ATOMIC(rank*sizeof(int));
         *cindp = cind = (int *)MALLOC_ATOMIC((col-rank)*sizeof(int));
         init_eg(&eg_mul); init_eg(&eg_inv);
         init_eg(&eg_check); init_eg(&eg_intrat);
         period = F4_INTRAT_PERIOD;
         nsize = period;
         wxsize = rank*ri*nsize;
         wx = (int *)MALLOC_ATOMIC(wxsize*sizeof(int));
         for ( i = 0; i < wxsize; i++ ) wx[i] = 0;
         for ( q = ONE, count = 0; ; ) {
           if ( DP_Print )
             fprintf(stderr,"o");
           /* wc = -b mod md */
           get_eg(&tmp0);
           for ( i = 0; i < rank; i++ )
             for ( j = 0, bi = b[i], wi = wc[i]; j < ri; j++ )
               if ( u = (Q)bi[j] ) {
                 t = rem(NM(u),md);
                 if ( t && SGN(u) > 0 )
                   t = (md - t) % md;
                 wi[j] = t;
               } else
                 wi[j] = 0;
           /* wc = A^(-1)wc; wc is not normalized */
           solve_by_lu_mod(w,rank,md,wc,ri,0);
           /* wx += q*wc */
           ptr = wx;
           for ( i = 0; i < rank; i++ )
             for ( j = 0, wi = wc[i]; j < ri; j++ ) {
               if ( wi[j] )
                 muln_1(BD(NM(q)),PL(NM(q)),wi[j],ptr);
               ptr += nsize;
             }
           count++;
           get_eg(&tmp1);
           add_eg(&eg_inv,&tmp0,&tmp1);
           get_eg(&tmp0);
           for ( i = 0; i < rank; i++ )
             for ( j = 0; j < ri; j++ ) {
               inner_product_mat_int_mod(a,wc,rank,i,j,&u);
               addq(b[i][j],u,&s);
               if ( s ) {
                 t = divin(NM(s),md,&tn);
                 if ( t )
                   error("generic_gauss_elim_hensel:incosistent");
                 NTOQ(tn,SGN(s),b[i][j]);
               } else
                 b[i][j] = 0;
             }
           get_eg(&tmp1);
           add_eg(&eg_mul,&tmp0,&tmp1);
           /* q = q*md */
           mulq(q,mdq,&u); q = u;
           if ( count == period ) {
             get_eg(&tmp0);
             ptr = wx;
             for ( i = 0; i < rank; i++ )
               for ( j = 0, xi = x[i]; j < ri;
                 j++, ptr += nsize ) {
                 for ( k = nsize-1; k >= 0 && !ptr[k]; k-- );
                 if ( k >= 0 ) {
                   wn = NALLOC(k+1);
                   PL(wn) = k+1;
                   for ( l = 0; l <= k; l++ ) BD(wn)[l] = (unsigned int)ptr[l];
                   NTOQ(wn,1,wq);
                   subq(xi[j],wq,&u); xi[j] = u;
                 }
               }
             ret = intmtoratm_q(xmat,NM(q),*nmmat,dn);
             get_eg(&tmp1); add_eg(&eg_intrat,&tmp0,&tmp1);
             if ( ret ) {
               for ( j = k = l = 0; j < col; j++ )
                 if ( cinfo[j] > 0 )
                   rind[k++] = j;
                 else if ( !cinfo[j] )
                   cind[l++] = j;
               get_eg(&tmp0);
               ret = gensolve_check(mat,*nmmat,*dn,rind,cind);
               get_eg(&tmp1); add_eg(&eg_check,&tmp0,&tmp1);
               if ( ret ) {
                 if ( DP_Print > 3 ) {
                   fprintf(stderr,"\n");
                   print_eg("INV",&eg_inv);
                   print_eg("MUL",&eg_mul);
                   print_eg("INTRAT",&eg_intrat);
                   print_eg("CHECK",&eg_check);
                   fflush(asir_out);
                 }
                 return rank;
               }
             } else {
               period = period*3/2;
               count = 0;
               nsize += period;
               wxsize += rank*ri*nsize;
               wx = (int *)REALLOC(wx,wxsize*sizeof(int));
               for ( i = 0; i < wxsize; i++ ) wx[i] = 0;
             }
           }
         }
     }
   }
   
 int f4_nocheck;  int f4_nocheck;
   
 int gensolve_check(mat,nm,dn,rind,cind)  int gensolve_check(MAT mat,MAT nm,Q dn,int *rind,int *cind)
 MAT mat,nm;  
 Q dn;  
 int *rind,*cind;  
 {  {
         int row,col,rank,clen,i,j,k,l;    int row,col,rank,clen,i,j,k,l;
         Q s,t,u;    Q s,t;
         Q *w;    Q *w;
         Q *mati,*nmk;    Q *mati,*nmk;
   
         if ( f4_nocheck )    if ( f4_nocheck )
                 return 1;      return 1;
         row = mat->row; col = mat->col;    row = mat->row; col = mat->col;
         rank = nm->row; clen = nm->col;    rank = nm->row; clen = nm->col;
         w = (Q *)MALLOC(clen*sizeof(Q));    w = (Q *)MALLOC(clen*sizeof(Q));
         for ( i = 0; i < row; i++ ) {    for ( i = 0; i < row; i++ ) {
                 mati = (Q *)mat->body[i];      mati = (Q *)mat->body[i];
 #if 1  #if 1
                 bzero(w,clen*sizeof(Q));      bzero(w,clen*sizeof(Q));
                 for ( k = 0; k < rank; k++ )      for ( k = 0; k < rank; k++ )
                         for ( l = 0, nmk = (Q *)nm->body[k]; l < clen; l++ ) {        for ( l = 0, nmk = (Q *)nm->body[k]; l < clen; l++ ) {
                                 mulq(mati[rind[k]],nmk[l],&t);          mulq(mati[rind[k]],nmk[l],&t);
                                 addq(w[l],t,&s); w[l] = s;          addq(w[l],t,&s); w[l] = s;
                         }        }
                 for ( j = 0; j < clen; j++ ) {      for ( j = 0; j < clen; j++ ) {
                         mulq(dn,mati[cind[j]],&t);        mulq(dn,mati[cind[j]],&t);
                         if ( cmpq(w[j],t) )        if ( cmpq(w[j],t) )
                                 break;          break;
                 }      }
 #else  #else
                 for ( j = 0; j < clen; j++ ) {      for ( j = 0; j < clen; j++ ) {
                         for ( k = 0, s = 0; k < rank; k++ ) {        for ( k = 0, s = 0; k < rank; k++ ) {
                                 mulq(mati[rind[k]],nm->body[k][j],&t);          mulq(mati[rind[k]],nm->body[k][j],&t);
                                 addq(s,t,&u); s = u;          addq(s,t,&u); s = u;
                         }        }
                         mulq(dn,mati[cind[j]],&t);        mulq(dn,mati[cind[j]],&t);
                         if ( cmpq(s,t) )        if ( cmpq(s,t) )
                                 break;          break;
                 }      }
 #endif  #endif
                 if ( j != clen )      if ( j != clen )
                         break;        break;
         }    }
         if ( i != row )    if ( i != row )
                 return 0;      return 0;
         else    else
                 return 1;      return 1;
 }  }
   
 /* assuming 0 < c < m */  /* assuming 0 < c < m */
   
 int inttorat(c,m,b,sgnp,nmp,dnp)  int inttorat(N c,N m,N b,int *sgnp,N *nmp,N *dnp)
 N c,m,b;  
 int *sgnp;  
 N *nmp,*dnp;  
 {  {
         Q qq,t,u1,v1,r1,nm;    Q qq,t,u1,v1,r1;
         N q,r,u2,v2,r2;    N q,u2,v2,r2;
   
         u1 = 0; v1 = ONE; u2 = m; v2 = c;    u1 = 0; v1 = ONE; u2 = m; v2 = c;
         while ( cmpn(v2,b) >= 0 ) {    while ( cmpn(v2,b) >= 0 ) {
                 divn(u2,v2,&q,&r2); u2 = v2; v2 = r2;      divn(u2,v2,&q,&r2); u2 = v2; v2 = r2;
                 NTOQ(q,1,qq); mulq(qq,v1,&t); subq(u1,t,&r1); u1 = v1; v1 = r1;      NTOQ(q,1,qq); mulq(qq,v1,&t); subq(u1,t,&r1); u1 = v1; v1 = r1;
         }    }
         if ( cmpn(NM(v1),b) >= 0 )    if ( cmpn(NM(v1),b) >= 0 )
                 return 0;      return 0;
         else {    else {
                 *nmp = v2;      *nmp = v2;
                 *dnp = NM(v1);      *dnp = NM(v1);
                 *sgnp = SGN(v1);      *sgnp = SGN(v1);
                 return 1;      return 1;
         }    }
 }  }
   
 /* mat->body = N ** */  /* mat->body = N ** */
   
 int intmtoratm(mat,md,nm,dn)  int intmtoratm(MAT mat,N md,MAT nm,Q *dn)
 MAT mat;  
 N md;  
 MAT nm;  
 Q *dn;  
 {  {
         N t,s,b;    N t,s,b;
         Q bound,dn0,dn1,nm1,q,tq;    Q dn0,dn1,nm1,q;
         int i,j,k,l,row,col;    int i,j,k,l,row,col;
         Q **rmat;    Q **rmat;
         N **tmat;    N **tmat;
         N *tmi;    N *tmi;
         Q *nmk;    Q *nmk;
         N u,unm,udn;    N u,unm,udn;
         int sgn,ret;    int sgn,ret;
   
         if ( UNIN(md) )    if ( UNIN(md) )
                 return 0;      return 0;
         row = mat->row; col = mat->col;    row = mat->row; col = mat->col;
         bshiftn(md,1,&t);    bshiftn(md,1,&t);
         isqrt(t,&s);    isqrt(t,&s);
         bshiftn(s,64,&b);    bshiftn(s,64,&b);
         if ( !b )    if ( !b )
                 b = ONEN;      b = ONEN;
         dn0 = ONE;    dn0 = ONE;
         tmat = (N **)mat->body;    tmat = (N **)mat->body;
         rmat = (Q **)nm->body;    rmat = (Q **)nm->body;
         for ( i = 0; i < row; i++ )    for ( i = 0; i < row; i++ )
                 for ( j = 0, tmi = tmat[i]; j < col; j++ )      for ( j = 0, tmi = tmat[i]; j < col; j++ )
                         if ( tmi[j] ) {        if ( tmi[j] ) {
                                 muln(tmi[j],NM(dn0),&s);          muln(tmi[j],NM(dn0),&s);
                                 remn(s,md,&u);          remn(s,md,&u);
                                 ret = inttorat(u,md,b,&sgn,&unm,&udn);          ret = inttorat(u,md,b,&sgn,&unm,&udn);
                                 if ( !ret )          if ( !ret )
                                         return 0;            return 0;
                                 else {          else {
                                         NTOQ(unm,sgn,nm1);            NTOQ(unm,sgn,nm1);
                                         NTOQ(udn,1,dn1);            NTOQ(udn,1,dn1);
                                         if ( !UNIQ(dn1) ) {            if ( !UNIQ(dn1) ) {
                                                 for ( k = 0; k < i; k++ )              for ( k = 0; k < i; k++ )
                                                         for ( l = 0, nmk = rmat[k]; l < col; l++ ) {                for ( l = 0, nmk = rmat[k]; l < col; l++ ) {
                                                                 mulq(nmk[l],dn1,&q); nmk[l] = q;                  mulq(nmk[l],dn1,&q); nmk[l] = q;
                                                         }                }
                                                 for ( l = 0, nmk = rmat[i]; l < j; l++ ) {              for ( l = 0, nmk = rmat[i]; l < j; l++ ) {
                                                         mulq(nmk[l],dn1,&q); nmk[l] = q;                mulq(nmk[l],dn1,&q); nmk[l] = q;
                                                 }              }
                                         }            }
                                         rmat[i][j] = nm1;            rmat[i][j] = nm1;
                                         mulq(dn0,dn1,&q); dn0 = q;            mulq(dn0,dn1,&q); dn0 = q;
                                 }          }
                         }        }
         *dn = dn0;    *dn = dn0;
         return 1;    return 1;
 }  }
   
 /* mat->body = Q ** */  /* mat->body = Q ** */
   
 int intmtoratm_q(mat,md,nm,dn)  int intmtoratm_q(MAT mat,N md,MAT nm,Q *dn)
 MAT mat;  
 N md;  
 MAT nm;  
 Q *dn;  
 {  {
         N t,s,b;    N t,s,b;
         Q bound,dn0,dn1,nm1,q,tq;    Q dn0,dn1,nm1,q;
         int i,j,k,l,row,col;    int i,j,k,l,row,col;
         Q **rmat;    Q **rmat;
         Q **tmat;    Q **tmat;
         Q *tmi;    Q *tmi;
         Q *nmk;    Q *nmk;
         N u,unm,udn;    N u,unm,udn;
         int sgn,ret;    int sgn,ret;
   
         if ( UNIN(md) )    if ( UNIN(md) )
                 return 0;      return 0;
         row = mat->row; col = mat->col;    row = mat->row; col = mat->col;
         bshiftn(md,1,&t);    bshiftn(md,1,&t);
         isqrt(t,&s);    isqrt(t,&s);
         bshiftn(s,64,&b);    bshiftn(s,64,&b);
         if ( !b )    if ( !b )
                 b = ONEN;      b = ONEN;
         dn0 = ONE;    dn0 = ONE;
         tmat = (Q **)mat->body;    tmat = (Q **)mat->body;
         rmat = (Q **)nm->body;    rmat = (Q **)nm->body;
         for ( i = 0; i < row; i++ )    for ( i = 0; i < row; i++ )
                 for ( j = 0, tmi = tmat[i]; j < col; j++ )      for ( j = 0, tmi = tmat[i]; j < col; j++ )
                         if ( tmi[j] ) {        if ( tmi[j] ) {
                                 muln(NM(tmi[j]),NM(dn0),&s);          muln(NM(tmi[j]),NM(dn0),&s);
                                 remn(s,md,&u);          remn(s,md,&u);
                                 ret = inttorat(u,md,b,&sgn,&unm,&udn);          ret = inttorat(u,md,b,&sgn,&unm,&udn);
                                 if ( !ret )          if ( !ret )
                                         return 0;            return 0;
                                 else {          else {
                                         if ( SGN(tmi[j])<0 )            if ( SGN(tmi[j])<0 )
                                                 sgn = -sgn;              sgn = -sgn;
                                         NTOQ(unm,sgn,nm1);            NTOQ(unm,sgn,nm1);
                                         NTOQ(udn,1,dn1);            NTOQ(udn,1,dn1);
                                         if ( !UNIQ(dn1) ) {            if ( !UNIQ(dn1) ) {
                                                 for ( k = 0; k < i; k++ )              for ( k = 0; k < i; k++ )
                                                         for ( l = 0, nmk = rmat[k]; l < col; l++ ) {                for ( l = 0, nmk = rmat[k]; l < col; l++ ) {
                                                                 mulq(nmk[l],dn1,&q); nmk[l] = q;                  mulq(nmk[l],dn1,&q); nmk[l] = q;
                                                         }                }
                                                 for ( l = 0, nmk = rmat[i]; l < j; l++ ) {              for ( l = 0, nmk = rmat[i]; l < j; l++ ) {
                                                         mulq(nmk[l],dn1,&q); nmk[l] = q;                mulq(nmk[l],dn1,&q); nmk[l] = q;
                                                 }              }
                                         }            }
                                         rmat[i][j] = nm1;            rmat[i][j] = nm1;
                                         mulq(dn0,dn1,&q); dn0 = q;            mulq(dn0,dn1,&q); dn0 = q;
                                 }          }
                         }        }
         *dn = dn0;    *dn = dn0;
         return 1;    return 1;
 }  }
   
 int generic_gauss_elim_mod(mat,row,col,md,colstat)  #define ONE_STEP1  if ( zzz = *s ) { DMAR(zzz,hc,*tj,md,*tj) } tj++; s++;
 int **mat;  
 int row,col,md;  void reduce_reducers_mod(int **mat,int row,int col,int md)
 int *colstat;  
 {  {
         int i,j,k,l,inv,a,rank;    int i,j,k,l,hc,zzz;
         int *t,*pivot;    int *t,*s,*tj,*ind;
   
         for ( rank = 0, j = 0; j < col; j++ ) {    /* reduce the reducers */
                 for ( i = rank; i < row && !mat[i][j]; i++ );    ind = (int *)ALLOCA(row*sizeof(int));
                 if ( i == row ) {    for ( i = 0; i < row; i++ ) {
                         colstat[j] = 0;      t = mat[i];
                         continue;      for ( j = 0; j < col && !t[j]; j++ );
                 } else      /* register the position of the head term */
                         colstat[j] = 1;      ind[i] = j;
                 if ( i != rank ) {      for ( l = i-1; l >= 0; l-- ) {
                         t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;        /* reduce mat[i] by mat[l] */
                 }        if ( hc = t[ind[l]] ) {
                 pivot = mat[rank];          /* mat[i] = mat[i]-hc*mat[l] */
                 inv = invm(pivot[j],md);          j = ind[l];
                 for ( k = j; k < col; k++ )          s = mat[l]+j;
                         if ( pivot[k] ) {          tj = t+j;
                                 DMAR(pivot[k],inv,0,md,pivot[k])          hc = md-hc;
                         }          k = col-j;
                 for ( i = rank+1; i < row; i++ ) {          for ( ; k >= 64; k -= 64 ) {
                         t = mat[i];            ONE_STEP1 ONE_STEP1 ONE_STEP1 ONE_STEP1
                         if ( a = t[j] )            ONE_STEP1 ONE_STEP1 ONE_STEP1 ONE_STEP1
                                 for ( k = j, a = md - a; k < col; k++ )            ONE_STEP1 ONE_STEP1 ONE_STEP1 ONE_STEP1
                                         if ( pivot[k] ) {            ONE_STEP1 ONE_STEP1 ONE_STEP1 ONE_STEP1
                                                 DMAR(pivot[k],a,t[k],md,t[k])            ONE_STEP1 ONE_STEP1 ONE_STEP1 ONE_STEP1
                                         }            ONE_STEP1 ONE_STEP1 ONE_STEP1 ONE_STEP1
                 }            ONE_STEP1 ONE_STEP1 ONE_STEP1 ONE_STEP1
                 rank++;            ONE_STEP1 ONE_STEP1 ONE_STEP1 ONE_STEP1
         }            ONE_STEP1 ONE_STEP1 ONE_STEP1 ONE_STEP1
         for ( j = col-1, l = rank-1; j >= 0; j-- )            ONE_STEP1 ONE_STEP1 ONE_STEP1 ONE_STEP1
                 if ( colstat[j] ) {            ONE_STEP1 ONE_STEP1 ONE_STEP1 ONE_STEP1
                         pivot = mat[l];            ONE_STEP1 ONE_STEP1 ONE_STEP1 ONE_STEP1
                         for ( i = 0; i < l; i++ ) {            ONE_STEP1 ONE_STEP1 ONE_STEP1 ONE_STEP1
                                 t = mat[i];            ONE_STEP1 ONE_STEP1 ONE_STEP1 ONE_STEP1
                                 if ( a = t[j] )            ONE_STEP1 ONE_STEP1 ONE_STEP1 ONE_STEP1
                                         for ( k = j, a = md-a; k < col; k++ )            ONE_STEP1 ONE_STEP1 ONE_STEP1 ONE_STEP1
                                                 if ( pivot[k] ) {          }
                                                         DMAR(pivot[k],a,t[k],md,t[k])          for ( ; k > 0; k-- ) {
                                                 }            if ( zzz = *s ) { DMAR(zzz,hc,*tj,md,*tj) } tj++; s++;
                         }          }
                         l--;        }
                 }      }
         return rank;    }
 }  }
   
   /*
     mat[i] : reducers (i=0,...,nred-1)
              spolys (i=nred,...,row-1)
     mat[0] < mat[1] < ... < mat[nred-1] w.r.t the term order
     1. reduce the reducers
     2. reduce spolys by the reduced reducers
   */
   
   void pre_reduce_mod(int **mat,int row,int col,int nred,int md)
   {
     int i,j,k,l,hc,inv;
     int *t,*s,*tk,*ind;
   
   #if 1
     /* reduce the reducers */
     ind = (int *)ALLOCA(row*sizeof(int));
     for ( i = 0; i < nred; i++ ) {
       /* make mat[i] monic and mat[i] by mat[0],...,mat[i-1] */
       t = mat[i];
       for ( j = 0; j < col && !t[j]; j++ );
       /* register the position of the head term */
       ind[i] = j;
       inv = invm(t[j],md);
       for ( k = j; k < col; k++ )
         if ( t[k] )
           DMAR(t[k],inv,0,md,t[k])
       for ( l = i-1; l >= 0; l-- ) {
         /* reduce mat[i] by mat[l] */
         if ( hc = t[ind[l]] ) {
           /* mat[i] = mat[i]-hc*mat[l] */
           for ( k = ind[l], hc = md-hc, s = mat[l]+k, tk = t+k;
             k < col; k++, tk++, s++ )
             if ( *s )
               DMAR(*s,hc,*tk,md,*tk)
         }
       }
     }
     /* reduce the spolys */
     for ( i = nred; i < row; i++ ) {
       t = mat[i];
       for ( l = nred-1; l >= 0; l-- ) {
         /* reduce mat[i] by mat[l] */
         if ( hc = t[ind[l]] ) {
           /* mat[i] = mat[i]-hc*mat[l] */
           for ( k = ind[l], hc = md-hc, s = mat[l]+k, tk = t+k;
             k < col; k++, tk++, s++ )
             if ( *s )
               DMAR(*s,hc,*tk,md,*tk)
         }
       }
     }
   #endif
   }
   /*
     mat[i] : reducers (i=0,...,nred-1)
     mat[0] < mat[1] < ... < mat[nred-1] w.r.t the term order
   */
   
   void reduce_sp_by_red_mod(int *sp,int **redmat,int *ind,int nred,int col,int md)
   {
     int i,j,k,hc,zzz;
     int *s,*tj;
   
     /* reduce the spolys by redmat */
     for ( i = nred-1; i >= 0; i-- ) {
       /* reduce sp by redmat[i] */
       if ( hc = sp[ind[i]] ) {
         /* sp = sp-hc*redmat[i] */
         j = ind[i];
         hc = md-hc;
         s = redmat[i]+j;
         tj = sp+j;
         for ( k = col-j; k > 0; k-- ) {
           if ( zzz = *s ) { DMAR(zzz,hc,*tj,md,*tj) } tj++; s++;
         }
       }
     }
   }
   
   /*
     mat[i] : compressed reducers (i=0,...,nred-1)
     mat[0] < mat[1] < ... < mat[nred-1] w.r.t the term order
   */
   
   void red_by_compress(int m,unsigned int *p,unsigned int *r,
     unsigned int *ri,unsigned int hc,int len)
   {
     unsigned int up,lo;
     unsigned int dmy;
     unsigned int *pj;
   
     p[*ri] = 0; r++; ri++;
     for ( len--; len; len--, r++, ri++ ) {
       pj = p+ *ri;
       DMA(*r,hc,*pj,up,lo);
       if ( up ) {
         DSAB(m,up,lo,dmy,*pj);
       } else
         *pj = lo;
     }
   }
   
   /* p -= hc*r */
   
   void red_by_vect(int m,unsigned int *p,unsigned int *r,unsigned int hc,int len)
   {
     unsigned int up,lo,dmy;
   
     *p++ = 0; r++; len--;
     for ( ; len; len--, r++, p++ )
       if ( *r ) {
         DMA(*r,hc,*p,up,lo);
         if ( up ) {
           DSAB(m,up,lo,dmy,*p);
         } else
           *p = lo;
       }
   }
   
   #if defined(__GNUC__) && SIZEOF_LONG==8
   /* 64bit vector += UNIT vector(normalized) */
   
   void red_by_vect64(int m, U64 *p,unsigned int *c,U64 *r,unsigned int hc,int len)
   {
     U64 t;
   
     /* (p[0],c[0]) is normalized */
     *p++ = 0; *c++ = 0; r++; len--;
     for ( ; len; len--, r++, p++, c++ )
       if ( *r ) {
         t = (*p)+(*r)*hc;
         if ( t < *p ) (*c)++;
         *p = t;
       }
   }
   #endif
   
   void red_by_vect_sf(int m,unsigned int *p,unsigned int *r,unsigned int hc,int len)
   {
     *p++ = 0; r++; len--;
     for ( ; len; len--, r++, p++ )
       if ( *r )
         *p = _addsf(_mulsf(*r,hc),*p);
   }
   
   extern GZ current_mod_lf;
   extern int current_mod_lf_size;
   
   void red_by_vect_lf(mpz_t *p,mpz_t *r,mpz_t hc,int len)
   {
     mpz_set_ui(*p++,0); r++; len--;
     for ( ; len; len--, r++, p++ ) {
          mpz_addmul(*p,*r,hc);
   #if 0
          if ( mpz_size(*p) > current_mod_lf_size )
            mpz_mod(*p,*p,BDY(current_mod_lf));
   #endif
       }
   }
   
   
   extern unsigned int **psca;
   
   void reduce_sp_by_red_mod_compress (int *sp,CDP *redmat,int *ind,
     int nred,int col,int md)
   {
     int i,len;
     CDP ri;
     unsigned int hc;
     unsigned int *usp;
   
     usp = (unsigned int *)sp;
     /* reduce the spolys by redmat */
     for ( i = nred-1; i >= 0; i-- ) {
       /* reduce sp by redmat[i] */
       usp[ind[i]] %= md;
       if ( hc = usp[ind[i]] ) {
         /* sp = sp-hc*redmat[i] */
         hc = md-hc;
         ri = redmat[i];
         len = ri->len;
         red_by_compress(md,usp,psca[ri->psindex],ri->body,hc,len);
       }
     }
     for ( i = 0; i < col; i++ )
       if ( usp[i] >= (unsigned int)md )
         usp[i] %= md;
   }
   
   #define ONE_STEP2  if ( zzz = *pk ) { DMAR(zzz,a,*tk,md,*tk) } pk++; tk++;
   
   int generic_gauss_elim_mod(int **mat0,int row,int col,int md,int *colstat)
   {
     int i,j,k,l,inv,a,rank;
     unsigned int *t,*pivot,*pk;
     unsigned int **mat;
   
     mat = (unsigned int **)mat0;
     for ( rank = 0, j = 0; j < col; j++ ) {
       for ( i = rank; i < row; i++ )
         mat[i][j] %= md;
       for ( i = rank; i < row; i++ )
         if ( mat[i][j] )
           break;
       if ( i == row ) {
         colstat[j] = 0;
         continue;
       } else
         colstat[j] = 1;
       if ( i != rank ) {
         t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
       }
       pivot = mat[rank];
       inv = invm(pivot[j],md);
       for ( k = j, pk = pivot+k; k < col; k++, pk++ )
         if ( *pk ) {
           if ( *pk >= (unsigned int)md )
             *pk %= md;
           DMAR(*pk,inv,0,md,*pk)
         }
       for ( i = rank+1; i < row; i++ ) {
         t = mat[i];
         if ( a = t[j] )
           red_by_vect(md,t+j,pivot+j,md-a,col-j);
       }
       rank++;
     }
     for ( j = col-1, l = rank-1; j >= 0; j-- )
       if ( colstat[j] ) {
         pivot = mat[l];
         for ( i = 0; i < l; i++ ) {
           t = mat[i];
           t[j] %= md;
           if ( a = t[j] )
             red_by_vect(md,t+j,pivot+j,md-a,col-j);
         }
         l--;
       }
     for ( j = 0, l = 0; l < rank; j++ )
       if ( colstat[j] ) {
         t = mat[l];
         for ( k = j; k < col; k++ )
           if ( t[k] >= (unsigned int)md )
             t[k] %= md;
         l++;
       }
     return rank;
   }
   
   int generic_gauss_elim_mod2(int **mat0,int row,int col,int md,int *colstat,int *rowstat)
   {
     int i,j,k,l,inv,a,rank;
     unsigned int *t,*pivot,*pk;
     unsigned int **mat;
   
     for ( i = 0; i < row; i++ ) rowstat[i] = i;
     mat = (unsigned int **)mat0;
     for ( rank = 0, j = 0; j < col; j++ ) {
       for ( i = rank; i < row; i++ )
         mat[i][j] %= md;
       for ( i = rank; i < row; i++ )
         if ( mat[i][j] )
           break;
       if ( i == row ) {
         colstat[j] = 0;
         continue;
       } else
         colstat[j] = 1;
       if ( i != rank ) {
         t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
         k = rowstat[i]; rowstat[i] = rowstat[rank]; rowstat[rank] = k;
       }
       pivot = mat[rank];
       inv = invm(pivot[j],md);
       for ( k = j, pk = pivot+k; k < col; k++, pk++ )
         if ( *pk ) {
           if ( *pk >= (unsigned int)md )
             *pk %= md;
           DMAR(*pk,inv,0,md,*pk)
         }
       for ( i = rank+1; i < row; i++ ) {
         t = mat[i];
         if ( a = t[j] )
           red_by_vect(md,t+j,pivot+j,md-a,col-j);
       }
       rank++;
     }
     for ( j = col-1, l = rank-1; j >= 0; j-- )
       if ( colstat[j] ) {
         pivot = mat[l];
         for ( i = 0; i < l; i++ ) {
           t = mat[i];
           t[j] %= md;
           if ( a = t[j] )
             red_by_vect(md,t+j,pivot+j,md-a,col-j);
         }
         l--;
       }
     for ( j = 0, l = 0; l < rank; j++ )
       if ( colstat[j] ) {
         t = mat[l];
         for ( k = j; k < col; k++ )
           if ( t[k] >= (unsigned int)md )
             t[k] %= md;
         l++;
       }
     return rank;
   }
   
   int indep_rows_mod(int **mat0,int row,int col,int md,int *rowstat)
   {
     int i,j,k,l,inv,a,rank;
     unsigned int *t,*pivot,*pk;
     unsigned int **mat;
   
     for ( i = 0; i < row; i++ ) rowstat[i] = i;
     mat = (unsigned int **)mat0;
     for ( rank = 0, j = 0; j < col; j++ ) {
       for ( i = rank; i < row; i++ )
         mat[i][j] %= md;
       for ( i = rank; i < row; i++ )
         if ( mat[i][j] )
           break;
       if ( i == row ) continue;
       if ( i != rank ) {
         t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
         k = rowstat[i]; rowstat[i] = rowstat[rank]; rowstat[rank] = k;
       }
       pivot = mat[rank];
       inv = invm(pivot[j],md);
       for ( k = j, pk = pivot+k; k < col; k++, pk++ )
         if ( *pk ) {
           if ( *pk >= (unsigned int)md )
             *pk %= md;
           DMAR(*pk,inv,0,md,*pk)
         }
       for ( i = rank+1; i < row; i++ ) {
         t = mat[i];
         if ( a = t[j] )
           red_by_vect(md,t+j,pivot+j,md-a,col-j);
       }
       rank++;
     }
     return rank;
   }
   
   int generic_gauss_elim_sf(int **mat0,int row,int col,int md,int *colstat)
   {
     int i,j,k,l,inv,a,rank;
     unsigned int *t,*pivot,*pk;
     unsigned int **mat;
   
     mat = (unsigned int **)mat0;
     for ( rank = 0, j = 0; j < col; j++ ) {
       for ( i = rank; i < row; i++ )
         if ( mat[i][j] )
           break;
       if ( i == row ) {
         colstat[j] = 0;
         continue;
       } else
         colstat[j] = 1;
       if ( i != rank ) {
         t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
       }
       pivot = mat[rank];
       inv = _invsf(pivot[j]);
       for ( k = j, pk = pivot+k; k < col; k++, pk++ )
         if ( *pk )
           *pk = _mulsf(*pk,inv);
       for ( i = rank+1; i < row; i++ ) {
         t = mat[i];
         if ( a = t[j] )
           red_by_vect_sf(md,t+j,pivot+j,_chsgnsf(a),col-j);
       }
       rank++;
     }
     for ( j = col-1, l = rank-1; j >= 0; j-- )
       if ( colstat[j] ) {
         pivot = mat[l];
         for ( i = 0; i < l; i++ ) {
           t = mat[i];
           if ( a = t[j] )
             red_by_vect_sf(md,t+j,pivot+j,_chsgnsf(a),col-j);
         }
         l--;
       }
     return rank;
   }
   
 /* LU decomposition; a[i][i] = 1/U[i][i] */  /* LU decomposition; a[i][i] = 1/U[i][i] */
   
 int lu_gfmmat(mat,md,perm)  int lu_gfmmat(GFMMAT mat,unsigned int md,int *perm)
 GFMMAT mat;  
 unsigned int md;  
 int *perm;  
 {  {
         int row,col;    int row,col;
         int i,j,k,l;    int i,j,k;
         unsigned int *t,*pivot;    unsigned int *t,*pivot;
         unsigned int **a;    unsigned int **a;
         unsigned int inv,m;    unsigned int inv,m;
   
         row = mat->row; col = mat->col;    row = mat->row; col = mat->col;
         a = mat->body;    a = mat->body;
         bzero(perm,row*sizeof(int));    bzero(perm,row*sizeof(int));
   
         for ( i = 0; i < row; i++ )    for ( i = 0; i < row; i++ )
                 perm[i] = i;      perm[i] = i;
         for ( k = 0; k < col; k++ ) {    for ( k = 0; k < col; k++ ) {
                 for ( i = k; i < row && !a[i][k]; i++ );      for ( i = k; i < row && !a[i][k]; i++ );
                 if ( i == row )      if ( i == row )
                         return 0;        return 0;
                 if ( i != k ) {      if ( i != k ) {
                         j = perm[i]; perm[i] = perm[k]; perm[k] = j;        j = perm[i]; perm[i] = perm[k]; perm[k] = j;
                         t = a[i]; a[i] = a[k]; a[k] = t;        t = a[i]; a[i] = a[k]; a[k] = t;
                 }      }
                 pivot = a[k];      pivot = a[k];
                 pivot[k] = inv = invm(pivot[k],md);      pivot[k] = inv = invm(pivot[k],md);
                 for ( i = k+1; i < row; i++ ) {      for ( i = k+1; i < row; i++ ) {
                         t = a[i];        t = a[i];
                         if ( m = t[k] ) {        if ( m = t[k] ) {
                                 DMAR(inv,m,0,md,t[k])          DMAR(inv,m,0,md,t[k])
                                 for ( j = k+1, m = md - t[k]; j < col; j++ )          for ( j = k+1, m = md - t[k]; j < col; j++ )
                                         if ( pivot[j] ) {            if ( pivot[j] ) {
                                                 DMAR(m,pivot[j],t[j],md,t[j])              unsigned int tj;
                                         }  
                         }              DMAR(m,pivot[j],t[j],md,tj)
                 }              t[j] = tj;
         }            }
         return 1;        }
       }
     }
     return 1;
 }  }
   
 /*  /*
  Input   Input
         a: a row x col matrix    a: a row x col matrix
         md : a modulus    md : a modulus
   
  Output:   Output:
         return : d = the rank of mat    return : d = the rank of mat
         a[0..(d-1)][0..(d-1)] : LU decomposition (a[i][i] = 1/U[i][i])    a[0..(d-1)][0..(d-1)] : LU decomposition (a[i][i] = 1/U[i][i])
         rinfo: array of length row    rinfo: array of length row
         cinfo: array of length col    cinfo: array of length col
     i-th row in new a <-> rinfo[i]-th row in old a      i-th row in new a <-> rinfo[i]-th row in old a
         cinfo[j]=1 <=> j-th column is contained in the LU decomp.    cinfo[j]=1 <=> j-th column is contained in the LU decomp.
 */  */
   
 int find_lhs_and_lu_mod(a,row,col,md,rinfo,cinfo)  int find_lhs_and_lu_mod(unsigned int **a,int row,int col,
 unsigned int **a;    unsigned int md,int **rinfo,int **cinfo)
 unsigned int md;  
 int **rinfo,**cinfo;  
 {  {
         int i,j,k,l,d;    int i,j,k,d;
         int *rp,*cp;    int *rp,*cp;
         unsigned int *t,*pivot;    unsigned int *t,*pivot;
         unsigned int inv,m;    unsigned int inv,m;
   
         *rinfo = rp = (int *)MALLOC_ATOMIC(row*sizeof(int));    *rinfo = rp = (int *)MALLOC_ATOMIC(row*sizeof(int));
         *cinfo = cp = (int *)MALLOC_ATOMIC(col*sizeof(int));    *cinfo = cp = (int *)MALLOC_ATOMIC(col*sizeof(int));
         for ( i = 0; i < row; i++ )    for ( i = 0; i < row; i++ )
                 rp[i] = i;      rp[i] = i;
         for ( k = 0, d = 0; k < col; k++ ) {    for ( k = 0, d = 0; k < col; k++ ) {
                 for ( i = d; i < row && !a[i][k]; i++ );      for ( i = d; i < row && !a[i][k]; i++ );
                 if ( i == row ) {      if ( i == row ) {
                         cp[k] = 0;        cp[k] = 0;
                         continue;        continue;
                 } else      } else
                         cp[k] = 1;        cp[k] = 1;
                 if ( i != d ) {      if ( i != d ) {
                         j = rp[i]; rp[i] = rp[d]; rp[d] = j;        j = rp[i]; rp[i] = rp[d]; rp[d] = j;
                         t = a[i]; a[i] = a[d]; a[d] = t;        t = a[i]; a[i] = a[d]; a[d] = t;
                 }      }
                 pivot = a[d];      pivot = a[d];
                 pivot[k] = inv = invm(pivot[k],md);      pivot[k] = inv = invm(pivot[k],md);
                 for ( i = d+1; i < row; i++ ) {      for ( i = d+1; i < row; i++ ) {
                         t = a[i];        t = a[i];
                         if ( m = t[k] ) {        if ( m = t[k] ) {
                                 DMAR(inv,m,0,md,t[k])          DMAR(inv,m,0,md,t[k])
                                 for ( j = k+1, m = md - t[k]; j < col; j++ )          for ( j = k+1, m = md - t[k]; j < col; j++ )
                                         if ( pivot[j] ) {            if ( pivot[j] ) {
                                                 DMAR(m,pivot[j],t[j],md,t[j])              unsigned int tj;
                                         }              DMAR(m,pivot[j],t[j],md,tj)
                         }              t[j] = tj;
                 }            }
                 d++;        }
         }      }
         return d;      d++;
     }
     return d;
 }  }
   
   int lu_mod(unsigned int **a,int n,unsigned int md,int **rinfo)
   {
     int i,j,k;
     int *rp;
     unsigned int *t,*pivot;
     unsigned int inv,m;
   
     *rinfo = rp = (int *)MALLOC_ATOMIC(n*sizeof(int));
     for ( i = 0; i < n; i++ ) rp[i] = i;
     for ( k = 0; k < n; k++ ) {
       for ( i = k; i < n && !a[i][k]; i++ );
       if ( i == n ) return 0;
       if ( i != k ) {
         j = rp[i]; rp[i] = rp[k]; rp[k] = j;
         t = a[i]; a[i] = a[k]; a[k] = t;
       }
       pivot = a[k];
       inv = invm(pivot[k],md);
       for ( i = k+1; i < n; i++ ) {
         t = a[i];
         if ( m = t[k] ) {
           DMAR(inv,m,0,md,t[k])
           for ( j = k+1, m = md - t[k]; j < n; j++ )
             if ( pivot[j] ) {
               unsigned int tj;
               DMAR(m,pivot[j],t[j],md,tj)
               t[j] = tj;
             }
         }
       }
     }
     return 1;
   }
   
 /*  /*
   Input    Input
         a : n x n matrix; a result of LU-decomposition    a : n x n matrix; a result of LU-decomposition
         md : modulus    md : modulus
         b : n x l matrix    b : n x l matrix
  Output   Output
         b = a^(-1)b    b = a^(-1)b
  */   */
   
 void solve_by_lu_mod(a,n,md,b,l)  void solve_by_lu_mod(int **a,int n,int md,int **b,int l,int normalize)
 int **a;  
 int n;  
 int md;  
 int **b;  
 int l;  
 {  {
         unsigned int *y,*c;    unsigned int *y,*c;
         int i,j,k;    int i,j,k;
         unsigned int t,m,m2;    unsigned int t,m,m2;
   
         y = (int *)MALLOC_ATOMIC(n*sizeof(int));    y = (int *)MALLOC_ATOMIC(n*sizeof(int));
         c = (int *)MALLOC_ATOMIC(n*sizeof(int));    c = (int *)MALLOC_ATOMIC(n*sizeof(int));
         m2 = md>>1;    m2 = md>>1;
         for ( k = 0; k < l; k++ ) {    for ( k = 0; k < l; k++ ) {
                 /* copy b[.][k] to c */      /* copy b[.][k] to c */
                 for ( i = 0; i < n; i++ )      for ( i = 0; i < n; i++ )
                         c[i] = (unsigned int)b[i][k];        c[i] = (unsigned int)b[i][k];
                 /* solve Ly=c */      /* solve Ly=c */
                 for ( i = 0; i < n; i++ ) {      for ( i = 0; i < n; i++ ) {
                         for ( t = c[i], j = 0; j < i; j++ )        for ( t = c[i], j = 0; j < i; j++ )
                                 if ( a[i][j] ) {          if ( a[i][j] ) {
                                         m = md - a[i][j];            m = md - a[i][j];
                                         DMAR(m,y[j],t,md,t)            DMAR(m,y[j],t,md,t)
                                 }          }
                         y[i] = t;        y[i] = t;
                 }      }
                 /* solve Uc=y */      /* solve Uc=y */
                 for ( i = n-1; i >= 0; i-- ) {      for ( i = n-1; i >= 0; i-- ) {
                         for ( t = y[i], j =i+1; j < n; j++ )        for ( t = y[i], j =i+1; j < n; j++ )
                                 if ( a[i][j] ) {          if ( a[i][j] ) {
                                         m = md - a[i][j];            m = md - a[i][j];
                                         DMAR(m,c[j],t,md,t)            DMAR(m,c[j],t,md,t)
                                 }          }
                         /* a[i][i] = 1/U[i][i] */        /* a[i][i] = 1/U[i][i] */
                         DMAR(t,a[i][i],0,md,c[i])        DMAR(t,a[i][i],0,md,c[i])
                 }      }
                 /* copy c to b[.][k] with normalization */      /* copy c to b[.][k] with normalization */
                 for ( i = 0; i < n; i++ )      if ( normalize )
                         b[i][k] = (int)(c[i]>m2 ? c[i]-md : c[i]);        for ( i = 0; i < n; i++ )
         }          b[i][k] = (int)(c[i]>m2 ? c[i]-md : c[i]);
       else
         for ( i = 0; i < n; i++ )
           b[i][k] = c[i];
     }
 }  }
   
 void Pleqm1(arg,rp)  void Pleqm1(NODE arg,VECT *rp)
 NODE arg;  
 VECT *rp;  
 {  {
         MAT m;    MAT m;
         VECT vect;    VECT vect;
         pointer **mat;    pointer **mat;
         Q *v;    Q *v;
         Q q;    Q q;
         int **wmat;    int **wmat;
         int md,i,j,row,col,t,n,status;    int md,i,j,row,col,t,n,status;
   
         asir_assert(ARG0(arg),O_MAT,"leqm1");    asir_assert(ARG0(arg),O_MAT,"leqm1");
         asir_assert(ARG1(arg),O_N,"leqm1");    asir_assert(ARG1(arg),O_N,"leqm1");
         m = (MAT)ARG0(arg); md = QTOS((Q)ARG1(arg));    m = (MAT)ARG0(arg); md = QTOS((Q)ARG1(arg));
         row = m->row; col = m->col; mat = m->body;    row = m->row; col = m->col; mat = m->body;
         wmat = (int **)almat(row,col);    wmat = (int **)almat(row,col);
         for ( i = 0; i < row; i++ )    for ( i = 0; i < row; i++ )
                 for ( j = 0; j < col; j++ )      for ( j = 0; j < col; j++ )
                         if ( q = (Q)mat[i][j] ) {        if ( q = (Q)mat[i][j] ) {
                                 t = rem(NM(q),md);          t = rem(NM(q),md);
                                 if ( SGN(q) < 0 )          if ( SGN(q) < 0 )
                                         t = (md - t) % md;            t = (md - t) % md;
                                 wmat[i][j] = t;          wmat[i][j] = t;
                         } else        } else
                                 wmat[i][j] = 0;          wmat[i][j] = 0;
         status = gauss_elim_mod1(wmat,row,col,md);    status = gauss_elim_mod1(wmat,row,col,md);
         if ( status < 0 )    if ( status < 0 )
                 *rp = 0;      *rp = 0;
         else if ( status > 0 )    else if ( status > 0 )
                 *rp = (VECT)ONE;      *rp = (VECT)ONE;
         else {    else {
                 n = col - 1;      n = col - 1;
                 MKVECT(vect,n);      MKVECT(vect,n);
                 for ( i = 0, v = (Q *)vect->body; i < n; i++ ) {      for ( i = 0, v = (Q *)vect->body; i < n; i++ ) {
                         t = (md-wmat[i][n])%md; STOQ(t,v[i]);        t = (md-wmat[i][n])%md; STOQ(t,v[i]);
                 }      }
                 *rp = vect;      *rp = vect;
         }    }
 }  }
   
 gauss_elim_mod1(mat,row,col,md)  int gauss_elim_mod1(int **mat,int row,int col,int md)
 int **mat;  
 int row,col,md;  
 {  {
         int i,j,k,inv,a,n;    int i,j,k,inv,a,n;
         int *t,*pivot;    int *t,*pivot;
   
         n = col - 1;    n = col - 1;
         for ( j = 0; j < n; j++ ) {    for ( j = 0; j < n; j++ ) {
                 for ( i = j; i < row && !mat[i][j]; i++ );      for ( i = j; i < row && !mat[i][j]; i++ );
                 if ( i == row )      if ( i == row )
                         return 1;        return 1;
                 if ( i != j ) {      if ( i != j ) {
                         t = mat[i]; mat[i] = mat[j]; mat[j] = t;        t = mat[i]; mat[i] = mat[j]; mat[j] = t;
                 }      }
                 pivot = mat[j];      pivot = mat[j];
                 inv = invm(pivot[j],md);      inv = invm(pivot[j],md);
                 for ( k = j; k <= n; k++ )      for ( k = j; k <= n; k++ )
                         pivot[k] = dmar(pivot[k],inv,0,md);        pivot[k] = dmar(pivot[k],inv,0,md);
                 for ( i = j+1; i < row; i++ ) {      for ( i = j+1; i < row; i++ ) {
                         t = mat[i];        t = mat[i];
                         if ( i != j && (a = t[j]) )        if ( i != j && (a = t[j]) )
                                 for ( k = j, a = md - a; k <= n; k++ )          for ( k = j, a = md - a; k <= n; k++ )
                                         t[k] = dmar(pivot[k],a,t[k],md);            t[k] = dmar(pivot[k],a,t[k],md);
                 }      }
         }    }
         for ( i = n; i < row && !mat[i][n]; i++ );    for ( i = n; i < row && !mat[i][n]; i++ );
         if ( i == row ) {    if ( i == row ) {
                 for ( j = n-1; j >= 0; j-- ) {      for ( j = n-1; j >= 0; j-- ) {
                         for ( i = j-1, a = (md-mat[j][n])%md; i >= 0; i-- ) {        for ( i = j-1, a = (md-mat[j][n])%md; i >= 0; i-- ) {
                                 mat[i][n] = dmar(mat[i][j],a,mat[i][n],md);          mat[i][n] = dmar(mat[i][j],a,mat[i][n],md);
                                 mat[i][j] = 0;          mat[i][j] = 0;
                         }        }
                 }      }
                 return 0;      return 0;
         } else    } else
                 return -1;      return -1;
 }  }
   
 void Pgeninvm(arg,rp)  void Pgeninvm(NODE arg,LIST *rp)
 NODE arg;  
 LIST *rp;  
 {  {
         MAT m;    MAT m;
         pointer **mat;    pointer **mat;
         Q **tmat;    Q **tmat;
         Q q;    Q q;
         unsigned int **wmat;    unsigned int **wmat;
         int md,i,j,row,col,t,status;    int md,i,j,row,col,t,status;
         MAT mat1,mat2;    MAT mat1,mat2;
         NODE node1,node2;    NODE node1,node2;
   
         asir_assert(ARG0(arg),O_MAT,"leqm1");    asir_assert(ARG0(arg),O_MAT,"leqm1");
         asir_assert(ARG1(arg),O_N,"leqm1");    asir_assert(ARG1(arg),O_N,"leqm1");
         m = (MAT)ARG0(arg); md = QTOS((Q)ARG1(arg));    m = (MAT)ARG0(arg); md = QTOS((Q)ARG1(arg));
         row = m->row; col = m->col; mat = m->body;    row = m->row; col = m->col; mat = m->body;
         wmat = (unsigned int **)almat(row,col+row);    wmat = (unsigned int **)almat(row,col+row);
         for ( i = 0; i < row; i++ ) {    for ( i = 0; i < row; i++ ) {
                 bzero((char *)wmat[i],(col+row)*sizeof(int));      bzero((char *)wmat[i],(col+row)*sizeof(int));
                 for ( j = 0; j < col; j++ )      for ( j = 0; j < col; j++ )
                         if ( q = (Q)mat[i][j] ) {        if ( q = (Q)mat[i][j] ) {
                                 t = rem(NM(q),md);          t = rem(NM(q),md);
                                 if ( SGN(q) < 0 )          if ( SGN(q) < 0 )
                                         t = (md - t) % md;            t = (md - t) % md;
                                 wmat[i][j] = t;          wmat[i][j] = t;
                         }        }
                 wmat[i][col+i] = 1;      wmat[i][col+i] = 1;
         }    }
         status = gauss_elim_geninv_mod(wmat,row,col,md);    status = gauss_elim_geninv_mod(wmat,row,col,md);
         if ( status > 0 )    if ( status > 0 )
                 *rp = 0;      *rp = 0;
         else {    else {
                 MKMAT(mat1,col,row); MKMAT(mat2,row-col,row);      MKMAT(mat1,col,row); MKMAT(mat2,row-col,row);
                 for ( i = 0, tmat = (Q **)mat1->body; i < col; i++ )      for ( i = 0, tmat = (Q **)mat1->body; i < col; i++ )
                         for ( j = 0; j < row; j++ )        for ( j = 0; j < row; j++ )
                                 STOQ(wmat[i][j+col],tmat[i][j]);          UTOQ(wmat[i][j+col],tmat[i][j]);
                 for ( tmat = (Q **)mat2->body; i < row; i++ )      for ( tmat = (Q **)mat2->body; i < row; i++ )
                         for ( j = 0; j < row; j++ )        for ( j = 0; j < row; j++ )
                                 STOQ(wmat[i][j+col],tmat[i-col][j]);          UTOQ(wmat[i][j+col],tmat[i-col][j]);
                 MKNODE(node2,mat2,0); MKNODE(node1,mat1,node2); MKLIST(*rp,node1);       MKNODE(node2,mat2,0); MKNODE(node1,mat1,node2); MKLIST(*rp,node1);
         }    }
 }  }
   
 int gauss_elim_geninv_mod(mat,row,col,md)  int gauss_elim_geninv_mod(unsigned int **mat,int row,int col,int md)
 unsigned int **mat;  
 int row,col,md;  
 {  {
         int i,j,k,inv,a,n,m;    int i,j,k,inv,a,n,m;
         unsigned int *t,*pivot;    unsigned int *t,*pivot;
   
         n = col; m = row+col;    n = col; m = row+col;
         for ( j = 0; j < n; j++ ) {    for ( j = 0; j < n; j++ ) {
                 for ( i = j; i < row && !mat[i][j]; i++ );      for ( i = j; i < row && !mat[i][j]; i++ );
                 if ( i == row )      if ( i == row )
                         return 1;        return 1;
                 if ( i != j ) {      if ( i != j ) {
                         t = mat[i]; mat[i] = mat[j]; mat[j] = t;        t = mat[i]; mat[i] = mat[j]; mat[j] = t;
                 }      }
                 pivot = mat[j];      pivot = mat[j];
                 inv = invm(pivot[j],md);      inv = invm(pivot[j],md);
                 for ( k = j; k < m; k++ )      for ( k = j; k < m; k++ )
                         pivot[k] = dmar(pivot[k],inv,0,md);        pivot[k] = dmar(pivot[k],inv,0,md);
                 for ( i = j+1; i < row; i++ ) {      for ( i = j+1; i < row; i++ ) {
                         t = mat[i];        t = mat[i];
                         if ( a = t[j] )        if ( a = t[j] )
                                 for ( k = j, a = md - a; k < m; k++ )          for ( k = j, a = md - a; k < m; k++ )
                                         t[k] = dmar(pivot[k],a,t[k],md);            t[k] = dmar(pivot[k],a,t[k],md);
                 }      }
         }    }
         for ( j = n-1; j >= 0; j-- ) {    for ( j = n-1; j >= 0; j-- ) {
                 pivot = mat[j];      pivot = mat[j];
                 for ( i = j-1; i >= 0; i-- ) {      for ( i = j-1; i >= 0; i-- ) {
                         t = mat[i];        t = mat[i];
                         if ( a = t[j] )        if ( a = t[j] )
                                 for ( k = j, a = md - a; k < m; k++ )          for ( k = j, a = md - a; k < m; k++ )
                                         t[k] = dmar(pivot[k],a,t[k],md);            t[k] = dmar(pivot[k],a,t[k],md);
                 }      }
         }    }
         return 0;    return 0;
 }  }
   
 void Psolve_by_lu_gfmmat(arg,rp)  void Psolve_by_lu_gfmmat(NODE arg,VECT *rp)
 NODE arg;  
 VECT *rp;  
 {  {
         GFMMAT lu;    GFMMAT lu;
         Q *perm,*rhs,*v;    Q *perm,*rhs,*v;
         int n,i;    int n,i;
         unsigned int md;    unsigned int md;
         unsigned int *b,*sol;    unsigned int *b,*sol;
         VECT r;    VECT r;
   
         lu = (GFMMAT)ARG0(arg);    lu = (GFMMAT)ARG0(arg);
         perm = (Q *)BDY((VECT)ARG1(arg));    perm = (Q *)BDY((VECT)ARG1(arg));
         rhs = (Q *)BDY((VECT)ARG2(arg));    rhs = (Q *)BDY((VECT)ARG2(arg));
         md = (unsigned int)QTOS((Q)ARG3(arg));    md = (unsigned int)QTOS((Q)ARG3(arg));
         n = lu->col;    n = lu->col;
         b = (unsigned int *)MALLOC_ATOMIC(n*sizeof(int));    b = (unsigned int *)MALLOC_ATOMIC(n*sizeof(int));
         sol = (unsigned int *)MALLOC_ATOMIC(n*sizeof(int));    sol = (unsigned int *)MALLOC_ATOMIC(n*sizeof(int));
         for ( i = 0; i < n; i++ )    for ( i = 0; i < n; i++ )
                 b[i] = QTOS(rhs[QTOS(perm[i])]);      b[i] = QTOS(rhs[QTOS(perm[i])]);
         solve_by_lu_gfmmat(lu,md,b,sol);    solve_by_lu_gfmmat(lu,md,b,sol);
         MKVECT(r,n);    MKVECT(r,n);
         for ( i = 0, v = (Q *)r->body; i < n; i++ )    for ( i = 0, v = (Q *)r->body; i < n; i++ )
                         STOQ(sol[i],v[i]);        UTOQ(sol[i],v[i]);
         *rp = r;    *rp = r;
 }  }
   
 void solve_by_lu_gfmmat(lu,md,b,x)  void solve_by_lu_gfmmat(GFMMAT lu,unsigned int md,
 GFMMAT lu;    unsigned int *b,unsigned int *x)
 unsigned int md;  
 unsigned int *b;  
 unsigned int *x;  
 {  {
         int n;    int n;
         unsigned int **a;    unsigned int **a;
         unsigned int *y;    unsigned int *y;
         int i,j;    int i,j;
         unsigned int t,m;    unsigned int t,m;
   
         n = lu->col;    n = lu->col;
         a = lu->body;    a = lu->body;
         y = (unsigned int *)MALLOC_ATOMIC(n*sizeof(int));    y = (unsigned int *)MALLOC_ATOMIC(n*sizeof(int));
         /* solve Ly=b */    /* solve Ly=b */
         for ( i = 0; i < n; i++ ) {    for ( i = 0; i < n; i++ ) {
                 for ( t = b[i], j = 0; j < i; j++ )      for ( t = b[i], j = 0; j < i; j++ )
                         if ( a[i][j] ) {        if ( a[i][j] ) {
                                 m = md - a[i][j];          m = md - a[i][j];
                                 DMAR(m,y[j],t,md,t)          DMAR(m,y[j],t,md,t)
                         }        }
                 y[i] = t;      y[i] = t;
         }    }
         /* solve Ux=y */    /* solve Ux=y */
         for ( i = n-1; i >= 0; i-- ) {    for ( i = n-1; i >= 0; i-- ) {
                 for ( t = y[i], j =i+1; j < n; j++ )      for ( t = y[i], j =i+1; j < n; j++ )
                         if ( a[i][j] ) {        if ( a[i][j] ) {
                                 m = md - a[i][j];          m = md - a[i][j];
                                 DMAR(m,x[j],t,md,t)          DMAR(m,x[j],t,md,t)
                         }        }
                 /* a[i][i] = 1/U[i][i] */      /* a[i][i] = 1/U[i][i] */
                 DMAR(t,a[i][i],0,md,x[i])      DMAR(t,a[i][i],0,md,x[i])
         }    }
 }  }
   
 void Plu_gfmmat(arg,rp)  void Plu_mat(NODE arg,LIST *rp)
 NODE arg;  
 LIST *rp;  
 {  {
         MAT m;    MAT m,lu;
         GFMMAT mm;    Q dn;
         unsigned int md;    Q *v;
         int i,row,col,status;    int n,i;
         int *iperm;    int *iperm;
         Q *v;    VECT perm;
         VECT perm;    NODE n0;
         NODE n0;  
   
         asir_assert(ARG0(arg),O_MAT,"mat_to_gfmmat");    asir_assert(ARG0(arg),O_MAT,"lu_mat");
         asir_assert(ARG1(arg),O_N,"mat_to_gfmmat");    m = (MAT)ARG0(arg);
         m = (MAT)ARG0(arg); md = (unsigned int)QTOS((Q)ARG1(arg));    n = m->row;
         mat_to_gfmmat(m,md,&mm);    MKMAT(lu,n,n);
         row = m->row;    lu_dec_cr(m,lu,&dn,&iperm);
         col = m->col;    MKVECT(perm,n);
         iperm = (int *)MALLOC_ATOMIC(row*sizeof(int));    for ( i = 0, v = (Q *)perm->body; i < n; i++ )
         status = lu_gfmmat(mm,md,iperm);      STOQ(iperm[i],v[i]);
         if ( !status )    n0 = mknode(3,lu,dn,perm);
                 n0 = 0;    MKLIST(*rp,n0);
         else {  
                 MKVECT(perm,row);  
                 for ( i = 0, v = (Q *)perm->body; i < row; i++ )  
                         STOQ(iperm[i],v[i]);  
                 n0 = mknode(2,mm,perm);  
         }  
         MKLIST(*rp,n0);  
 }  }
   
 void Pmat_to_gfmmat(arg,rp)  void Plu_gfmmat(NODE arg,LIST *rp)
 NODE arg;  
 GFMMAT *rp;  
 {  {
         MAT m;    MAT m;
         unsigned int md;    GFMMAT mm;
     unsigned int md;
     int i,row,col,status;
     int *iperm;
     Q *v;
     VECT perm;
     NODE n0;
   
         asir_assert(ARG0(arg),O_MAT,"mat_to_gfmmat");    asir_assert(ARG0(arg),O_MAT,"lu_gfmmat");
         asir_assert(ARG1(arg),O_N,"mat_to_gfmmat");    asir_assert(ARG1(arg),O_N,"lu_gfmmat");
         m = (MAT)ARG0(arg); md = (unsigned int)QTOS((Q)ARG1(arg));    m = (MAT)ARG0(arg); md = (unsigned int)QTOS((Q)ARG1(arg));
         mat_to_gfmmat(m,md,rp);    mat_to_gfmmat(m,md,&mm);
     row = m->row;
     col = m->col;
     iperm = (int *)MALLOC_ATOMIC(row*sizeof(int));
     status = lu_gfmmat(mm,md,iperm);
     if ( !status )
       n0 = 0;
     else {
       MKVECT(perm,row);
       for ( i = 0, v = (Q *)perm->body; i < row; i++ )
         STOQ(iperm[i],v[i]);
       n0 = mknode(2,mm,perm);
     }
     MKLIST(*rp,n0);
 }  }
   
 void mat_to_gfmmat(m,md,rp)  void Pmat_to_gfmmat(NODE arg,GFMMAT *rp)
 MAT m;  
 unsigned int md;  
 GFMMAT *rp;  
 {  {
         unsigned int **wmat;    MAT m;
         unsigned int t;    unsigned int md;
         Q **mat;  
         Q q;  
         int i,j,row,col;  
   
         row = m->row; col = m->col; mat = (Q **)m->body;    asir_assert(ARG0(arg),O_MAT,"mat_to_gfmmat");
         wmat = (unsigned int **)almat(row,col);    asir_assert(ARG1(arg),O_N,"mat_to_gfmmat");
         for ( i = 0; i < row; i++ ) {    m = (MAT)ARG0(arg); md = (unsigned int)QTOS((Q)ARG1(arg));
                 bzero((char *)wmat[i],col*sizeof(unsigned int));    mat_to_gfmmat(m,md,rp);
                 for ( j = 0; j < col; j++ )  
                         if ( q = mat[i][j] ) {  
                                 t = (unsigned int)rem(NM(q),md);  
                                 if ( SGN(q) < 0 )  
                                         t = (md - t) % md;  
                                 wmat[i][j] = t;  
                         }  
         }  
         TOGFMMAT(row,col,wmat,*rp);  
 }  }
   
 void Pgeninvm_swap(arg,rp)  void mat_to_gfmmat(MAT m,unsigned int md,GFMMAT *rp)
 NODE arg;  
 LIST *rp;  
 {  {
         MAT m;    unsigned int **wmat;
         pointer **mat;    unsigned int t;
         Q **tmat;    Q **mat;
         Q *tvect;    Q q;
         Q q;    int i,j,row,col;
         unsigned int **wmat,**invmat;  
         int *index;  
         unsigned int t,md;  
         int i,j,row,col,status;  
         MAT mat1;  
         VECT vect1;  
         NODE node1,node2;  
   
         asir_assert(ARG0(arg),O_MAT,"geninvm_swap");    row = m->row; col = m->col; mat = (Q **)m->body;
         asir_assert(ARG1(arg),O_N,"geninvm_swap");    wmat = (unsigned int **)almat(row,col);
         m = (MAT)ARG0(arg); md = QTOS((Q)ARG1(arg));    for ( i = 0; i < row; i++ ) {
         row = m->row; col = m->col; mat = m->body;      bzero((char *)wmat[i],col*sizeof(unsigned int));
         wmat = (unsigned int **)almat(row,col+row);      for ( j = 0; j < col; j++ )
         for ( i = 0; i < row; i++ ) {        if ( q = mat[i][j] ) {
                 bzero((char *)wmat[i],(col+row)*sizeof(int));          t = (unsigned int)rem(NM(q),md);
                 for ( j = 0; j < col; j++ )          if ( SGN(q) < 0 )
                         if ( q = (Q)mat[i][j] ) {            t = (md - t) % md;
                                 t = (unsigned int)rem(NM(q),md);          wmat[i][j] = t;
                                 if ( SGN(q) < 0 )        }
                                         t = (md - t) % md;    }
                                 wmat[i][j] = t;    TOGFMMAT(row,col,wmat,*rp);
                         }  
                 wmat[i][col+i] = 1;  
         }  
         status = gauss_elim_geninv_mod_swap(wmat,row,col,md,&invmat,&index);  
         if ( status > 0 )  
                 *rp = 0;  
         else {  
                 MKMAT(mat1,col,col);  
                 for ( i = 0, tmat = (Q **)mat1->body; i < col; i++ )  
                         for ( j = 0; j < col; j++ )  
                                 UTOQ(invmat[i][j],tmat[i][j]);  
                 MKVECT(vect1,row);  
                 for ( i = 0, tvect = (Q *)vect1->body; i < row; i++ )  
                         STOQ(index[i],tvect[i]);  
                 MKNODE(node2,vect1,0); MKNODE(node1,mat1,node2); MKLIST(*rp,node1);  
         }  
 }  }
   
 gauss_elim_geninv_mod_swap(mat,row,col,md,invmatp,indexp)  void Pgeninvm_swap(NODE arg,LIST *rp)
 unsigned int **mat;  
 int row,col;  
 unsigned int md;  
 unsigned int ***invmatp;  
 int **indexp;  
 {  {
         int i,j,k,inv,a,n,m;    MAT m;
         unsigned int *t,*pivot,*s;    pointer **mat;
         int *index;    Q **tmat;
         unsigned int **invmat;    Q *tvect;
     Q q;
     unsigned int **wmat,**invmat;
     int *index;
     unsigned int t,md;
     int i,j,row,col,status;
     MAT mat1;
     VECT vect1;
     NODE node1,node2;
   
         n = col; m = row+col;    asir_assert(ARG0(arg),O_MAT,"geninvm_swap");
         *indexp = index = (int *)MALLOC_ATOMIC(row*sizeof(int));    asir_assert(ARG1(arg),O_N,"geninvm_swap");
         for ( i = 0; i < row; i++ )    m = (MAT)ARG0(arg); md = QTOS((Q)ARG1(arg));
                 index[i] = i;    row = m->row; col = m->col; mat = m->body;
         for ( j = 0; j < n; j++ ) {    wmat = (unsigned int **)almat(row,col+row);
                 for ( i = j; i < row && !mat[i][j]; i++ );    for ( i = 0; i < row; i++ ) {
                 if ( i == row ) {      bzero((char *)wmat[i],(col+row)*sizeof(int));
                         *indexp = 0; *invmatp = 0; return 1;      for ( j = 0; j < col; j++ )
                 }        if ( q = (Q)mat[i][j] ) {
                 if ( i != j ) {          t = (unsigned int)rem(NM(q),md);
                         t = mat[i]; mat[i] = mat[j]; mat[j] = t;          if ( SGN(q) < 0 )
                         k = index[i]; index[i] = index[j]; index[j] = k;            t = (md - t) % md;
                 }          wmat[i][j] = t;
                 pivot = mat[j];        }
                 inv = (unsigned int)invm(pivot[j],md);      wmat[i][col+i] = 1;
                 for ( k = j; k < m; k++ )    }
                         if ( pivot[k] )    status = gauss_elim_geninv_mod_swap(wmat,row,col,md,&invmat,&index);
                                 pivot[k] = (unsigned int)dmar(pivot[k],inv,0,md);    if ( status > 0 )
                 for ( i = j+1; i < row; i++ ) {      *rp = 0;
                         t = mat[i];    else {
                         if ( a = t[j] )      MKMAT(mat1,col,col);
                                 for ( k = j, a = md - a; k < m; k++ )      for ( i = 0, tmat = (Q **)mat1->body; i < col; i++ )
                                         if ( pivot[k] )        for ( j = 0; j < col; j++ )
                                                 t[k] = dmar(pivot[k],a,t[k],md);          UTOQ(invmat[i][j],tmat[i][j]);
                 }      MKVECT(vect1,row);
         }      for ( i = 0, tvect = (Q *)vect1->body; i < row; i++ )
         for ( j = n-1; j >= 0; j-- ) {        STOQ(index[i],tvect[i]);
                 pivot = mat[j];       MKNODE(node2,vect1,0); MKNODE(node1,mat1,node2); MKLIST(*rp,node1);
                 for ( i = j-1; i >= 0; i-- ) {    }
                         t = mat[i];  
                         if ( a = t[j] )  
                                 for ( k = j, a = md - a; k < m; k++ )  
                                         if ( pivot[k] )  
                                                 t[k] = dmar(pivot[k],a,t[k],md);  
                 }  
         }  
         *invmatp = invmat = (unsigned int **)almat(col,col);  
         for ( i = 0; i < col; i++ )  
                 for ( j = 0, s = invmat[i], t = mat[i]; j < col; j++ )  
                         s[j] = t[col+index[j]];  
         return 0;  
 }  }
   
   int gauss_elim_geninv_mod_swap(unsigned int **mat,int row,int col,unsigned int md,
       unsigned int ***invmatp,int **indexp)
   {
     int i,j,k,inv,a,n,m;
     unsigned int *t,*pivot,*s;
     int *index;
     unsigned int **invmat;
   
     n = col; m = row+col;
     *indexp = index = (int *)MALLOC_ATOMIC(row*sizeof(int));
     for ( i = 0; i < row; i++ )
       index[i] = i;
     for ( j = 0; j < n; j++ ) {
       for ( i = j; i < row && !mat[i][j]; i++ );
       if ( i == row ) {
         *indexp = 0; *invmatp = 0; return 1;
       }
       if ( i != j ) {
         t = mat[i]; mat[i] = mat[j]; mat[j] = t;
         k = index[i]; index[i] = index[j]; index[j] = k;
       }
       pivot = mat[j];
       inv = (unsigned int)invm(pivot[j],md);
       for ( k = j; k < m; k++ )
         if ( pivot[k] )
           pivot[k] = (unsigned int)dmar(pivot[k],inv,0,md);
       for ( i = j+1; i < row; i++ ) {
         t = mat[i];
         if ( a = t[j] )
           for ( k = j, a = md - a; k < m; k++ )
             if ( pivot[k] )
               t[k] = dmar(pivot[k],a,t[k],md);
       }
     }
     for ( j = n-1; j >= 0; j-- ) {
       pivot = mat[j];
       for ( i = j-1; i >= 0; i-- ) {
         t = mat[i];
         if ( a = t[j] )
           for ( k = j, a = md - a; k < m; k++ )
             if ( pivot[k] )
               t[k] = dmar(pivot[k],a,t[k],md);
       }
     }
     *invmatp = invmat = (unsigned int **)almat(col,col);
     for ( i = 0; i < col; i++ )
       for ( j = 0, s = invmat[i], t = mat[i]; j < col; j++ )
         s[j] = t[col+index[j]];
     return 0;
   }
   
   void Pgeninv_sf_swap(NODE arg,LIST *rp)
   {
     MAT m;
     GFS **mat,**tmat;
     Q *tvect;
     GFS q;
     int **wmat,**invmat;
     int *index;
     unsigned int t;
     int i,j,row,col,status;
     MAT mat1;
     VECT vect1;
     NODE node1,node2;
   
     asir_assert(ARG0(arg),O_MAT,"geninv_sf_swap");
     m = (MAT)ARG0(arg);
     row = m->row; col = m->col; mat = (GFS **)m->body;
     wmat = (int **)almat(row,col+row);
     for ( i = 0; i < row; i++ ) {
       bzero((char *)wmat[i],(col+row)*sizeof(int));
       for ( j = 0; j < col; j++ )
         if ( q = (GFS)mat[i][j] )
           wmat[i][j] = FTOIF(CONT(q));
       wmat[i][col+i] = _onesf();
     }
     status = gauss_elim_geninv_sf_swap(wmat,row,col,&invmat,&index);
     if ( status > 0 )
       *rp = 0;
     else {
       MKMAT(mat1,col,col);
       for ( i = 0, tmat = (GFS **)mat1->body; i < col; i++ )
         for ( j = 0; j < col; j++ )
           if ( t = invmat[i][j] ) {
             MKGFS(IFTOF(t),tmat[i][j]);
           }
       MKVECT(vect1,row);
       for ( i = 0, tvect = (Q *)vect1->body; i < row; i++ )
         STOQ(index[i],tvect[i]);
        MKNODE(node2,vect1,0); MKNODE(node1,mat1,node2); MKLIST(*rp,node1);
     }
   }
   
   int gauss_elim_geninv_sf_swap(int **mat,int row,int col,
     int ***invmatp,int **indexp)
   {
     int i,j,k,inv,a,n,m,u;
     int *t,*pivot,*s;
     int *index;
     int **invmat;
   
     n = col; m = row+col;
     *indexp = index = (int *)MALLOC_ATOMIC(row*sizeof(int));
     for ( i = 0; i < row; i++ )
       index[i] = i;
     for ( j = 0; j < n; j++ ) {
       for ( i = j; i < row && !mat[i][j]; i++ );
       if ( i == row ) {
         *indexp = 0; *invmatp = 0; return 1;
       }
       if ( i != j ) {
         t = mat[i]; mat[i] = mat[j]; mat[j] = t;
         k = index[i]; index[i] = index[j]; index[j] = k;
       }
       pivot = mat[j];
       inv = _invsf(pivot[j]);
       for ( k = j; k < m; k++ )
         if ( pivot[k] )
           pivot[k] = _mulsf(pivot[k],inv);
       for ( i = j+1; i < row; i++ ) {
         t = mat[i];
         if ( a = t[j] )
           for ( k = j, a = _chsgnsf(a); k < m; k++ )
             if ( pivot[k] ) {
               u = _mulsf(pivot[k],a);
               t[k] = _addsf(u,t[k]);
             }
       }
     }
     for ( j = n-1; j >= 0; j-- ) {
       pivot = mat[j];
       for ( i = j-1; i >= 0; i-- ) {
         t = mat[i];
         if ( a = t[j] )
           for ( k = j, a = _chsgnsf(a); k < m; k++ )
             if ( pivot[k] ) {
               u = _mulsf(pivot[k],a);
               t[k] = _addsf(u,t[k]);
             }
       }
     }
     *invmatp = invmat = (int **)almat(col,col);
     for ( i = 0; i < col; i++ )
       for ( j = 0, s = invmat[i], t = mat[i]; j < col; j++ )
         s[j] = t[col+index[j]];
     return 0;
   }
   
 void _addn(N,N,N);  void _addn(N,N,N);
 int _subn(N,N,N);  int _subn(N,N,N);
 void _muln(N,N,N);  void _muln(N,N,N);
   
 void inner_product_int(a,b,n,r)  void inner_product_int(Q *a,Q *b,int n,Q *r)
 Q *a,*b;  
 int n;  
 Q *r;  
 {  {
         int la,lb,i;    int la,lb,i;
         int sgn,sgn1;    int sgn,sgn1;
         N wm,wma,sum,t;    N wm,wma,sum,t;
   
         for ( la = lb = 0, i = 0; i < n; i++ ) {    for ( la = lb = 0, i = 0; i < n; i++ ) {
                 if ( a[i] )      if ( a[i] )
                         if ( DN(a[i]) )        if ( DN(a[i]) )
                                 error("inner_product_int : invalid argument");          error("inner_product_int : invalid argument");
                         else        else
                                 la = MAX(PL(NM(a[i])),la);          la = MAX(PL(NM(a[i])),la);
                 if ( b[i] )      if ( b[i] )
                         if ( DN(b[i]) )        if ( DN(b[i]) )
                                 error("inner_product_int : invalid argument");          error("inner_product_int : invalid argument");
                         else        else
                                 lb = MAX(PL(NM(b[i])),lb);          lb = MAX(PL(NM(b[i])),lb);
         }    }
         sgn = 0;    sgn = 0;
         sum= NALLOC(la+lb+2);    sum= NALLOC(la+lb+2);
         bzero((char *)sum,(la+lb+3)*sizeof(unsigned int));    bzero((char *)sum,(la+lb+3)*sizeof(unsigned int));
         wm = NALLOC(la+lb+2);    wm = NALLOC(la+lb+2);
         wma = NALLOC(la+lb+2);    wma = NALLOC(la+lb+2);
         for ( i = 0; i < n; i++ ) {    for ( i = 0; i < n; i++ ) {
                 if ( !a[i] || !b[i] )      if ( !a[i] || !b[i] )
                         continue;        continue;
                 _muln(NM(a[i]),NM(b[i]),wm);      _muln(NM(a[i]),NM(b[i]),wm);
                 sgn1 = SGN(a[i])*SGN(b[i]);      sgn1 = SGN(a[i])*SGN(b[i]);
                 if ( !sgn ) {      if ( !sgn ) {
                         sgn = sgn1;        sgn = sgn1;
                         t = wm; wm = sum; sum = t;        t = wm; wm = sum; sum = t;
                 } else if ( sgn == sgn1 ) {      } else if ( sgn == sgn1 ) {
                         _addn(sum,wm,wma);        _addn(sum,wm,wma);
                         if ( !PL(wma) )        if ( !PL(wma) )
                                 sgn = 0;          sgn = 0;
                         t = wma; wma = sum; sum = t;        t = wma; wma = sum; sum = t;
                 } else {      } else {
                         /* sgn*sum+sgn1*wm = sgn*(sum-wm) */        /* sgn*sum+sgn1*wm = sgn*(sum-wm) */
                         sgn *= _subn(sum,wm,wma);        sgn *= _subn(sum,wm,wma);
                         t = wma; wma = sum; sum = t;        t = wma; wma = sum; sum = t;
                 }      }
         }    }
         GC_free(wm);    GCFREE(wm);
         GC_free(wma);    GCFREE(wma);
         if ( !sgn ) {    if ( !sgn ) {
                 GC_free(sum);      GCFREE(sum);
                 *r = 0;      *r = 0;
         } else    } else
                 NTOQ(sum,sgn,*r);      NTOQ(sum,sgn,*r);
 }  }
   
 /* (k,l) element of a*b where a: .x n matrix, b: n x . integer matrix */  /* (k,l) element of a*b where a: .x n matrix, b: n x . integer matrix */
   
 void inner_product_mat_int_mod(a,b,n,k,l,r)  void inner_product_mat_int_mod(Q **a,int **b,int n,int k,int l,Q *r)
 Q **a;  
 int **b;  
 int n,k,l;  
 Q *r;  
 {  {
         int la,lb,i;    int la,lb,i;
         int sgn,sgn1;    int sgn,sgn1;
         N wm,wma,sum,t;    N wm,wma,sum,t;
         Q aki;    Q aki;
         int bil,bilsgn;    int bil,bilsgn;
         struct oN tn;    struct oN tn;
   
         for ( la = 0, i = 0; i < n; i++ ) {    for ( la = 0, i = 0; i < n; i++ ) {
                 if ( aki = a[k][i] )      if ( aki = a[k][i] )
                         if ( DN(aki) )        if ( DN(aki) )
                                 error("inner_product_int : invalid argument");          error("inner_product_int : invalid argument");
                         else        else
                                 la = MAX(PL(NM(aki)),la);          la = MAX(PL(NM(aki)),la);
         }    }
         lb = 1;    lb = 1;
         sgn = 0;    sgn = 0;
         sum= NALLOC(la+lb+2);    sum= NALLOC(la+lb+2);
         bzero((char *)sum,(la+lb+3)*sizeof(unsigned int));    bzero((char *)sum,(la+lb+3)*sizeof(unsigned int));
         wm = NALLOC(la+lb+2);    wm = NALLOC(la+lb+2);
         wma = NALLOC(la+lb+2);    wma = NALLOC(la+lb+2);
         for ( i = 0; i < n; i++ ) {    for ( i = 0; i < n; i++ ) {
                 if ( !(aki = a[k][i]) || !(bil = b[i][l]) )      if ( !(aki = a[k][i]) || !(bil = b[i][l]) )
                         continue;        continue;
                 tn.p = 1;      tn.p = 1;
                 if ( bil > 0 ) {      if ( bil > 0 ) {
                         tn.b[0] = bil; bilsgn = 1;        tn.b[0] = bil; bilsgn = 1;
                 } else {      } else {
                         tn.b[0] = -bil; bilsgn = -1;        tn.b[0] = -bil; bilsgn = -1;
                 }      }
                 _muln(NM(aki),&tn,wm);      _muln(NM(aki),&tn,wm);
                 sgn1 = SGN(aki)*bilsgn;      sgn1 = SGN(aki)*bilsgn;
                 if ( !sgn ) {      if ( !sgn ) {
                         sgn = sgn1;        sgn = sgn1;
                         t = wm; wm = sum; sum = t;        t = wm; wm = sum; sum = t;
                 } else if ( sgn == sgn1 ) {      } else if ( sgn == sgn1 ) {
                         _addn(sum,wm,wma);        _addn(sum,wm,wma);
                         if ( !PL(wma) )        if ( !PL(wma) )
                                 sgn = 0;          sgn = 0;
                         t = wma; wma = sum; sum = t;        t = wma; wma = sum; sum = t;
                 } else {      } else {
                         /* sgn*sum+sgn1*wm = sgn*(sum-wm) */        /* sgn*sum+sgn1*wm = sgn*(sum-wm) */
                         sgn *= _subn(sum,wm,wma);        sgn *= _subn(sum,wm,wma);
                         t = wma; wma = sum; sum = t;        t = wma; wma = sum; sum = t;
                 }      }
         }    }
         GC_free(wm);    GCFREE(wm);
         GC_free(wma);    GCFREE(wma);
         if ( !sgn ) {    if ( !sgn ) {
                 GC_free(sum);      GCFREE(sum);
                 *r = 0;      *r = 0;
         } else    } else
                 NTOQ(sum,sgn,*r);      NTOQ(sum,sgn,*r);
 }  }
   
 void Pmul_mat_vect_int(arg,rp)  void Pmul_mat_vect_int(NODE arg,VECT *rp)
 NODE arg;  
 VECT *rp;  
 {  {
         MAT mat;    MAT mat;
         VECT vect,r;    VECT vect,r;
         int row,col,i;    int row,col,i;
   
         mat = (MAT)ARG0(arg);    mat = (MAT)ARG0(arg);
         vect = (VECT)ARG1(arg);    vect = (VECT)ARG1(arg);
         row = mat->row;    row = mat->row;
         col = mat->col;    col = mat->col;
         MKVECT(r,row);    MKVECT(r,row);
         for ( i = 0; i < row; i++ )    for ( i = 0; i < row; i++ ) {
                 inner_product_int(mat->body[i],vect->body,col,&r->body[i]);      inner_product_int((Q *)mat->body[i],(Q *)vect->body,col,(Q *)&r->body[i]);
         *rp = r;    }
     *rp = r;
 }  }
   
 void Pnbpoly_up2(arg,rp)  void Pnbpoly_up2(NODE arg,GF2N *rp)
 NODE arg;  
 GF2N *rp;  
 {  {
         int m,type,ret;    int m,type,ret;
         UP2 r;    UP2 r;
   
         m = QTOS((Q)ARG0(arg));    m = QTOS((Q)ARG0(arg));
         type = QTOS((Q)ARG1(arg));    type = QTOS((Q)ARG1(arg));
         ret = generate_ONB_polynomial(&r,m,type);    ret = generate_ONB_polynomial(&r,m,type);
         if ( ret == 0 )    if ( ret == 0 )
                 MKGF2N(r,*rp);      MKGF2N(r,*rp);
         else    else
                 *rp = 0;      *rp = 0;
 }  }
   
 void Px962_irredpoly_up2(arg,rp)  void Px962_irredpoly_up2(NODE arg,GF2N *rp)
 NODE arg;  
 GF2N *rp;  
 {  {
         int m,type,ret,w;    int m,ret,w;
         GF2N prev;    GF2N prev;
         UP2 r;    UP2 r;
   
         m = QTOS((Q)ARG0(arg));    m = QTOS((Q)ARG0(arg));
         prev = (GF2N)ARG1(arg);    prev = (GF2N)ARG1(arg);
         if ( !prev ) {    if ( !prev ) {
                 w = (m>>5)+1; NEWUP2(r,w); r->w = 0;      w = (m>>5)+1; NEWUP2(r,w); r->w = 0;
                 bzero((char *)r->b,w*sizeof(unsigned int));      bzero((char *)r->b,w*sizeof(unsigned int));
         } else {    } else {
                 r = prev->body;      r = prev->body;
                 if ( degup2(r) != m ) {      if ( degup2(r) != m ) {
                         w = (m>>5)+1; NEWUP2(r,w); r->w = 0;        w = (m>>5)+1; NEWUP2(r,w); r->w = 0;
                         bzero((char *)r->b,w*sizeof(unsigned int));        bzero((char *)r->b,w*sizeof(unsigned int));
                 }      }
         }    }
         ret = _generate_irreducible_polynomial(r,m,type);    ret = _generate_irreducible_polynomial(r,m);
         if ( ret == 0 )    if ( ret == 0 )
                 MKGF2N(r,*rp);      MKGF2N(r,*rp);
         else    else
                 *rp = 0;      *rp = 0;
 }  }
   
 void Pirredpoly_up2(arg,rp)  void Pirredpoly_up2(NODE arg,GF2N *rp)
 NODE arg;  
 GF2N *rp;  
 {  {
         int m,type,ret,w;    int m,ret,w;
         GF2N prev;    GF2N prev;
         UP2 r;    UP2 r;
   
         m = QTOS((Q)ARG0(arg));    m = QTOS((Q)ARG0(arg));
         prev = (GF2N)ARG1(arg);    prev = (GF2N)ARG1(arg);
         if ( !prev ) {    if ( !prev ) {
                 w = (m>>5)+1; NEWUP2(r,w); r->w = 0;      w = (m>>5)+1; NEWUP2(r,w); r->w = 0;
                 bzero((char *)r->b,w*sizeof(unsigned int));      bzero((char *)r->b,w*sizeof(unsigned int));
         } else {    } else {
                 r = prev->body;      r = prev->body;
                 if ( degup2(r) != m ) {      if ( degup2(r) != m ) {
                         w = (m>>5)+1; NEWUP2(r,w); r->w = 0;        w = (m>>5)+1; NEWUP2(r,w); r->w = 0;
                         bzero((char *)r->b,w*sizeof(unsigned int));        bzero((char *)r->b,w*sizeof(unsigned int));
                 }      }
         }    }
         ret = _generate_good_irreducible_polynomial(r,m,type);    ret = _generate_good_irreducible_polynomial(r,m);
         if ( ret == 0 )    if ( ret == 0 )
                 MKGF2N(r,*rp);      MKGF2N(r,*rp);
         else    else
                 *rp = 0;      *rp = 0;
 }  }
   
   void Pmat_swap_row_destructive(NODE arg, MAT *m)
   {
     int i1,i2;
     pointer *t;
     MAT mat;
   
     asir_assert(ARG0(arg),O_MAT,"mat_swap_row_destructive");
     asir_assert(ARG1(arg),O_N,"mat_swap_row_destructive");
     asir_assert(ARG2(arg),O_N,"mat_swap_row_destructive");
     mat = (MAT)ARG0(arg);
     i1 = QTOS((Q)ARG1(arg));
     i2 = QTOS((Q)ARG2(arg));
     if ( i1 < 0 || i2 < 0 || i1 >= mat->row || i2 >= mat->row )
       error("mat_swap_row_destructive : Out of range");
     t = mat->body[i1];
     mat->body[i1] = mat->body[i2];
     mat->body[i2] = t;
     *m = mat;
   }
   
   void Pmat_swap_col_destructive(NODE arg, MAT *m)
   {
     int j1,j2,i,n;
     pointer *mi;
     pointer t;
     MAT mat;
   
     asir_assert(ARG0(arg),O_MAT,"mat_swap_col_destructive");
     asir_assert(ARG1(arg),O_N,"mat_swap_col_destructive");
     asir_assert(ARG2(arg),O_N,"mat_swap_col_destructive");
     mat = (MAT)ARG0(arg);
     j1 = QTOS((Q)ARG1(arg));
     j2 = QTOS((Q)ARG2(arg));
     if ( j1 < 0 || j2 < 0 || j1 >= mat->col || j2 >= mat->col )
       error("mat_swap_col_destructive : Out of range");
     n = mat->row;
     for ( i = 0; i < n; i++ ) {
       mi = mat->body[i];
       t = mi[j1]; mi[j1] = mi[j2]; mi[j2] = t;
     }
     *m = mat;
   }
 /*  /*
  * f = type 'type' normal polynomial of degree m if exists   * f = type 'type' normal polynomial of degree m if exists
  * IEEE P1363 A.7.2   * IEEE P1363 A.7.2
Line 1967  GF2N *rp;
Line 3550  GF2N *rp;
   
 int generate_ONB_polynomial(UP2 *rp,int m,int type)  int generate_ONB_polynomial(UP2 *rp,int m,int type)
 {  {
         int i,r;    int i,r;
         int w;    int w;
         UP2 f,f0,f1,f2,t;    UP2 f,f0,f1,f2,t;
   
         w = (m>>5)+1;    w = (m>>5)+1;
         switch ( type ) {    switch ( type ) {
                 case 1:      case 1:
                         if ( !TypeT_NB_check(m,1) ) return 1;        if ( !TypeT_NB_check(m,1) ) return 1;
                         NEWUP2(f,w); *rp = f; f->w = w;        NEWUP2(f,w); *rp = f; f->w = w;
                         /* set all the bits */        /* set all the bits */
                         for ( i = 0; i < w; i++ )        for ( i = 0; i < w; i++ )
                                 f->b[i] = 0xffffffff;          f->b[i] = 0xffffffff;
                         /* mask the top word if necessary */        /* mask the top word if necessary */
                         if ( r = (m+1)&31 )        if ( r = (m+1)&31 )
                                 f->b[w-1] &= (1<<r)-1;          f->b[w-1] &= (1<<r)-1;
                         return 0;        return 0;
                         break;        break;
                 case 2:      case 2:
                         if ( !TypeT_NB_check(m,2) ) return 1;        if ( !TypeT_NB_check(m,2) ) return 1;
                         NEWUP2(f,w); *rp = f;        NEWUP2(f,w); *rp = f;
                         W_NEWUP2(f0,w);        W_NEWUP2(f0,w);
                         W_NEWUP2(f1,w);        W_NEWUP2(f1,w);
                         W_NEWUP2(f2,w);        W_NEWUP2(f2,w);
   
                         /* recursion for genrating Type II normal polynomial */        /* recursion for genrating Type II normal polynomial */
   
                         /* f0 = 1, f1 = t+1 */        /* f0 = 1, f1 = t+1 */
                         f0->w = 1; f0->b[0] = 1;        f0->w = 1; f0->b[0] = 1;
                         f1->w = 1; f1->b[0] = 3;        f1->w = 1; f1->b[0] = 3;
                         for ( i = 2; i <= m; i++ ) {        for ( i = 2; i <= m; i++ ) {
                                 /* f2 = t*f1+f0 */          /* f2 = t*f1+f0 */
                                 _bshiftup2(f1,-1,f2);          _bshiftup2(f1,-1,f2);
                                 _addup2_destructive(f2,f0);          _addup2_destructive(f2,f0);
                                 /* cyclic change of the variables */          /* cyclic change of the variables */
                                 t = f0; f0 = f1; f1 = f2; f2 = t;          t = f0; f0 = f1; f1 = f2; f2 = t;
                         }        }
                         _copyup2(f1,f);        _copyup2(f1,f);
                         return 0;        return 0;
                         break;        break;
                 default:      default:
                         return -1;        return -1;
                         break;        break;
                 }      }
 }  }
   
 /*  /*
Line 2020  int generate_ONB_polynomial(UP2 *rp,int m,int type)
Line 3603  int generate_ONB_polynomial(UP2 *rp,int m,int type)
   
 int _generate_irreducible_polynomial(UP2 f,int d)  int _generate_irreducible_polynomial(UP2 f,int d)
 {  {
         int ret,i,j,k,nz,i0,j0,k0;    int ret,i,j,k,nz,i0,j0,k0;
         int w;    int w;
         unsigned int *fd;    unsigned int *fd;
   
         /*    /*
          * if f = x^d+x^i+1 then i0 <- i, j0 <- 0, k0 <-0.     * if f = x^d+x^i+1 then i0 <- i, j0 <- 0, k0 <-0.
          * if f = x^d+x^k+x^j+x^i+1 (k>j>i) then i0 <- i, j0 <- j, k0 <-k.     * if f = x^d+x^k+x^j+x^i+1 (k>j>i) then i0 <- i, j0 <- j, k0 <-k.
          * otherwise i0,j0,k0 is set to 0.     * otherwise i0,j0,k0 is set to 0.
          */     */
   
         fd = f->b;    fd = f->b;
         w = (d>>5)+1;    w = (d>>5)+1;
         if ( f->w && (d==degup2(f)) ) {    if ( f->w && (d==degup2(f)) ) {
                 for ( nz = 0, i = d; i >= 0; i-- )      for ( nz = 0, i = d; i >= 0; i-- )
                         if ( fd[i>>5]&(1<<(i&31)) ) nz++;        if ( fd[i>>5]&(1<<(i&31)) ) nz++;
                 switch ( nz ) {      switch ( nz ) {
                         case 3:        case 3:
                                 for ( i0 = 1; !(fd[i0>>5]&(1<<(i0&31))) ; i0++ );          for ( i0 = 1; !(fd[i0>>5]&(1<<(i0&31))) ; i0++ );
                                 /* reset i0-th bit */          /* reset i0-th bit */
                                 fd[i0>>5] &= ~(1<<(i0&31));          fd[i0>>5] &= ~(1<<(i0&31));
                                 j0 = k0 = 0;          j0 = k0 = 0;
                                 break;          break;
                         case 5:        case 5:
                                 for ( i0 = 1; !(fd[i0>>5]&(1<<(i0&31))) ; i0++ );          for ( i0 = 1; !(fd[i0>>5]&(1<<(i0&31))) ; i0++ );
                                 /* reset i0-th bit */          /* reset i0-th bit */
                                 fd[i0>>5] &= ~(1<<(i0&31));          fd[i0>>5] &= ~(1<<(i0&31));
                                 for ( j0 = i0+1; !(fd[j0>>5]&(1<<(j0&31))) ; j0++ );          for ( j0 = i0+1; !(fd[j0>>5]&(1<<(j0&31))) ; j0++ );
                                 /* reset j0-th bit */          /* reset j0-th bit */
                                 fd[j0>>5] &= ~(1<<(j0&31));          fd[j0>>5] &= ~(1<<(j0&31));
                                 for ( k0 = j0+1; !(fd[k0>>5]&(1<<(k0&31))) ; k0++ );          for ( k0 = j0+1; !(fd[k0>>5]&(1<<(k0&31))) ; k0++ );
                                 /* reset k0-th bit */          /* reset k0-th bit */
                                 fd[k0>>5] &= ~(1<<(k0&31));          fd[k0>>5] &= ~(1<<(k0&31));
                                 break;          break;
                         default:        default:
                                 f->w = 0; break;          f->w = 0; break;
                 }      }
         } else    } else
                 f->w = 0;      f->w = 0;
   
         if ( !f->w ) {    if ( !f->w ) {
                 fd = f->b;      fd = f->b;
                 f->w = w; fd[0] |= 1; fd[d>>5] |= (1<<(d&31));      f->w = w; fd[0] |= 1; fd[d>>5] |= (1<<(d&31));
                 i0 = j0 = k0 = 0;      i0 = j0 = k0 = 0;
         }    }
         /* if j0 > 0 then f is already a pentanomial */    /* if j0 > 0 then f is already a pentanomial */
         if ( j0 > 0 ) goto PENTA;    if ( j0 > 0 ) goto PENTA;
   
         /* searching for an irreducible trinomial */    /* searching for an irreducible trinomial */
   
         for ( i = 1; 2*i <= d; i++ ) {    for ( i = 1; 2*i <= d; i++ ) {
                 /* skip the polynomials 'before' f */      /* skip the polynomials 'before' f */
                 if ( i < i0 ) continue;      if ( i < i0 ) continue;
                 if ( i == i0 ) { i0 = 0; continue; }      if ( i == i0 ) { i0 = 0; continue; }
                 /* set i-th bit */      /* set i-th bit */
                 fd[i>>5] |= (1<<(i&31));      fd[i>>5] |= (1<<(i&31));
                 ret = irredcheck_dddup2(f);      ret = irredcheck_dddup2(f);
                 if ( ret == 1 ) return 0;      if ( ret == 1 ) return 0;
                 /* reset i-th bit */      /* reset i-th bit */
                 fd[i>>5] &= ~(1<<(i&31));      fd[i>>5] &= ~(1<<(i&31));
         }    }
   
         /* searching for an irreducible pentanomial */    /* searching for an irreducible pentanomial */
 PENTA:  PENTA:
         for ( i = 1; i < d; i++ ) {    for ( i = 1; i < d; i++ ) {
                 /* skip the polynomials 'before' f */      /* skip the polynomials 'before' f */
                 if ( i < i0 ) continue;      if ( i < i0 ) continue;
                 if ( i == i0 ) i0 = 0;      if ( i == i0 ) i0 = 0;
                 /* set i-th bit */      /* set i-th bit */
                 fd[i>>5] |= (1<<(i&31));      fd[i>>5] |= (1<<(i&31));
                 for ( j = i+1; j < d; j++ ) {      for ( j = i+1; j < d; j++ ) {
                         /* skip the polynomials 'before' f */        /* skip the polynomials 'before' f */
                         if ( j < j0 ) continue;        if ( j < j0 ) continue;
                         if ( j == j0 ) j0 = 0;        if ( j == j0 ) j0 = 0;
                         /* set j-th bit */        /* set j-th bit */
                         fd[j>>5] |= (1<<(j&31));        fd[j>>5] |= (1<<(j&31));
                         for ( k = j+1; k < d; k++ ) {        for ( k = j+1; k < d; k++ ) {
                                 /* skip the polynomials 'before' f */          /* skip the polynomials 'before' f */
                                 if ( k < k0 ) continue;          if ( k < k0 ) continue;
                                 else if ( k == k0 ) { k0 = 0; continue; }          else if ( k == k0 ) { k0 = 0; continue; }
                                 /* set k-th bit */          /* set k-th bit */
                                 fd[k>>5] |= (1<<(k&31));          fd[k>>5] |= (1<<(k&31));
                                 ret = irredcheck_dddup2(f);          ret = irredcheck_dddup2(f);
                                 if ( ret == 1 ) return 0;          if ( ret == 1 ) return 0;
                                 /* reset k-th bit */          /* reset k-th bit */
                                 fd[k>>5] &= ~(1<<(k&31));          fd[k>>5] &= ~(1<<(k&31));
                         }        }
                         /* reset j-th bit */        /* reset j-th bit */
                         fd[j>>5] &= ~(1<<(j&31));        fd[j>>5] &= ~(1<<(j&31));
                 }      }
                 /* reset i-th bit */      /* reset i-th bit */
                 fd[i>>5] &= ~(1<<(i&31));      fd[i>>5] &= ~(1<<(i&31));
         }    }
         /* exhausted */    /* exhausted */
         return 1;    return 1;
 }  }
   
 /*  /*
Line 2133  PENTA:
Line 3716  PENTA:
   
 int _generate_good_irreducible_polynomial(UP2 f,int d)  int _generate_good_irreducible_polynomial(UP2 f,int d)
 {  {
         int ret,i,j,k,nz,i0,j0,k0;    int ret,i,j,k,nz,i0,j0,k0;
         int w;    int w;
         unsigned int *fd;    unsigned int *fd;
   
         /*    /*
          * if f = x^d+x^i+1 then i0 <- i, j0 <- 0, k0 <-0.     * if f = x^d+x^i+1 then i0 <- i, j0 <- 0, k0 <-0.
          * if f = x^d+x^k+x^j+x^i+1 (k>j>i) then i0 <- i, j0 <- j, k0 <-k.     * if f = x^d+x^k+x^j+x^i+1 (k>j>i) then i0 <- i, j0 <- j, k0 <-k.
          * otherwise i0,j0,k0 is set to 0.     * otherwise i0,j0,k0 is set to 0.
          */     */
   
         fd = f->b;    fd = f->b;
         w = (d>>5)+1;    w = (d>>5)+1;
         if ( f->w && (d==degup2(f)) ) {    if ( f->w && (d==degup2(f)) ) {
                 for ( nz = 0, i = d; i >= 0; i-- )      for ( nz = 0, i = d; i >= 0; i-- )
                         if ( fd[i>>5]&(1<<(i&31)) ) nz++;        if ( fd[i>>5]&(1<<(i&31)) ) nz++;
                 switch ( nz ) {      switch ( nz ) {
                         case 3:        case 3:
                                 for ( i0 = 1; !(fd[i0>>5]&(1<<(i0&31))) ; i0++ );          for ( i0 = 1; !(fd[i0>>5]&(1<<(i0&31))) ; i0++ );
                                 /* reset i0-th bit */          /* reset i0-th bit */
                                 fd[i0>>5] &= ~(1<<(i0&31));          fd[i0>>5] &= ~(1<<(i0&31));
                                 j0 = k0 = 0;          j0 = k0 = 0;
                                 break;          break;
                         case 5:        case 5:
                                 for ( i0 = 1; !(fd[i0>>5]&(1<<(i0&31))) ; i0++ );          for ( i0 = 1; !(fd[i0>>5]&(1<<(i0&31))) ; i0++ );
                                 /* reset i0-th bit */          /* reset i0-th bit */
                                 fd[i0>>5] &= ~(1<<(i0&31));          fd[i0>>5] &= ~(1<<(i0&31));
                                 for ( j0 = i0+1; !(fd[j0>>5]&(1<<(j0&31))) ; j0++ );          for ( j0 = i0+1; !(fd[j0>>5]&(1<<(j0&31))) ; j0++ );
                                 /* reset j0-th bit */          /* reset j0-th bit */
                                 fd[j0>>5] &= ~(1<<(j0&31));          fd[j0>>5] &= ~(1<<(j0&31));
                                 for ( k0 = j0+1; !(fd[k0>>5]&(1<<(k0&31))) ; k0++ );          for ( k0 = j0+1; !(fd[k0>>5]&(1<<(k0&31))) ; k0++ );
                                 /* reset k0-th bit */          /* reset k0-th bit */
                                 fd[k0>>5] &= ~(1<<(k0&31));          fd[k0>>5] &= ~(1<<(k0&31));
                                 break;          break;
                         default:        default:
                                 f->w = 0; break;          f->w = 0; break;
                 }      }
         } else    } else
                 f->w = 0;      f->w = 0;
   
         if ( !f->w ) {    if ( !f->w ) {
                 fd = f->b;      fd = f->b;
                 f->w = w; fd[0] |= 1; fd[d>>5] |= (1<<(d&31));      f->w = w; fd[0] |= 1; fd[d>>5] |= (1<<(d&31));
                 i0 = j0 = k0 = 0;      i0 = j0 = k0 = 0;
         }    }
         /* if j0 > 0 then f is already a pentanomial */    /* if j0 > 0 then f is already a pentanomial */
         if ( j0 > 0 ) goto PENTA;    if ( j0 > 0 ) goto PENTA;
   
         /* searching for an irreducible trinomial */    /* searching for an irreducible trinomial */
   
         for ( i = 1; 2*i <= d; i++ ) {    for ( i = 1; 2*i <= d; i++ ) {
                 /* skip the polynomials 'before' f */      /* skip the polynomials 'before' f */
                 if ( i < i0 ) continue;      if ( i < i0 ) continue;
                 if ( i == i0 ) { i0 = 0; continue; }      if ( i == i0 ) { i0 = 0; continue; }
                 /* set i-th bit */      /* set i-th bit */
                 fd[i>>5] |= (1<<(i&31));      fd[i>>5] |= (1<<(i&31));
                 ret = irredcheck_dddup2(f);      ret = irredcheck_dddup2(f);
                 if ( ret == 1 ) return 0;      if ( ret == 1 ) return 0;
                 /* reset i-th bit */      /* reset i-th bit */
                 fd[i>>5] &= ~(1<<(i&31));      fd[i>>5] &= ~(1<<(i&31));
         }    }
   
         /* searching for an irreducible pentanomial */    /* searching for an irreducible pentanomial */
 PENTA:  PENTA:
         for ( i = 3; i < d; i++ ) {    for ( i = 3; i < d; i++ ) {
                 /* skip the polynomials 'before' f */      /* skip the polynomials 'before' f */
                 if ( i < i0 ) continue;      if ( i < i0 ) continue;
                 if ( i == i0 ) i0 = 0;      if ( i == i0 ) i0 = 0;
                 /* set i-th bit */      /* set i-th bit */
                 fd[i>>5] |= (1<<(i&31));      fd[i>>5] |= (1<<(i&31));
                 for ( j = 2; j < i; j++ ) {       for ( j = 2; j < i; j++ ) {
                         /* skip the polynomials 'before' f */        /* skip the polynomials 'before' f */
                         if ( j < j0 ) continue;        if ( j < j0 ) continue;
                         if ( j == j0 ) j0 = 0;        if ( j == j0 ) j0 = 0;
                         /* set j-th bit */        /* set j-th bit */
                         fd[j>>5] |= (1<<(j&31));        fd[j>>5] |= (1<<(j&31));
                         for ( k = 1; k < j; k++ ) {         for ( k = 1; k < j; k++ ) {
                                 /* skip the polynomials 'before' f */          /* skip the polynomials 'before' f */
                                 if ( k < k0 ) continue;          if ( k < k0 ) continue;
                                 else if ( k == k0 ) { k0 = 0; continue; }          else if ( k == k0 ) { k0 = 0; continue; }
                                 /* set k-th bit */          /* set k-th bit */
                                 fd[k>>5] |= (1<<(k&31));          fd[k>>5] |= (1<<(k&31));
                                 ret = irredcheck_dddup2(f);          ret = irredcheck_dddup2(f);
                                 if ( ret == 1 ) return 0;          if ( ret == 1 ) return 0;
                                 /* reset k-th bit */          /* reset k-th bit */
                                 fd[k>>5] &= ~(1<<(k&31));          fd[k>>5] &= ~(1<<(k&31));
                         }        }
                         /* reset j-th bit */        /* reset j-th bit */
                         fd[j>>5] &= ~(1<<(j&31));        fd[j>>5] &= ~(1<<(j&31));
                 }      }
                 /* reset i-th bit */      /* reset i-th bit */
                 fd[i>>5] &= ~(1<<(i&31));      fd[i>>5] &= ~(1<<(i&31));
         }    }
         /* exhausted */    /* exhausted */
         return 1;    return 1;
 }  }
   
 printqmat(mat,row,col)  void printqmat(Q **mat,int row,int col)
 Q **mat;  
 int row,col;  
 {  {
         int i,j;    int i,j;
   
         for ( i = 0; i < row; i++ ) {    for ( i = 0; i < row; i++ ) {
                 for ( j = 0; j < col; j++ ) {      for ( j = 0; j < col; j++ ) {
                         printnum(mat[i][j]); printf(" ");        printnum((Num)mat[i][j]); printf(" ");
                 }      }
                 printf("\n");      printf("\n");
         }    }
 }  }
   
 printimat(mat,row,col)  void printimat(int **mat,int row,int col)
 int **mat;  
 int row,col;  
 {  {
         int i,j;    int i,j;
   
         for ( i = 0; i < row; i++ ) {    for ( i = 0; i < row; i++ ) {
                 for ( j = 0; j < col; j++ ) {      for ( j = 0; j < col; j++ ) {
                         printf("%d ",mat[i][j]);        printf("%d ",mat[i][j]);
                 }      }
                 printf("\n");      printf("\n");
         }    }
   }
   
   void Pnd_det(NODE arg,P *rp)
   {
     if ( argc(arg) == 1 )
       nd_det(0,ARG0(arg),rp);
     else
       nd_det(QTOS((Q)ARG1(arg)),ARG0(arg),rp);
   }
   
   void Pmat_col(NODE arg,VECT *rp)
   {
     int i,j,n;
     MAT mat;
     VECT vect;
   
     asir_assert(ARG0(arg),O_MAT,"mat_col");
     asir_assert(ARG1(arg),O_N,"mat_col");
     mat = (MAT)ARG0(arg);
     j = QTOS((Q)ARG1(arg));
     if ( j < 0 || j >= mat->col) {
       error("mat_col : Out of range");
     }
     n = mat->row;
     MKVECT(vect,n);
     for(i=0; i<n; i++) {
       BDY(vect)[i] = BDY(mat)[i][j];
     }
     *rp = vect;
   }
   
   NODE triangleq(NODE e)
   {
     int n,i,k;
     V v;
     VL vl;
     P *p;
     NODE r,r1;
   
     n = length(e);
     p = (P *)MALLOC(n*sizeof(P));
     for ( i = 0; i < n; i++, e = NEXT(e) ) p[i] = (P)BDY(e);
     i = 0;
     while ( 1 ) {
       for ( ; i < n && !p[i]; i++ );
       if ( i == n ) break;
       if ( OID(p[i]) == O_N ) return 0;
       v = p[i]->v;
       for ( k = i+1; k < n; k++ )
         if ( p[k] ) {
           if ( OID(p[k]) == O_N ) return 0;
           if ( p[k]->v == v ) p[k] = 0;
         }
       i++;
     }
     for ( r = 0, i = 0; i < n; i++ ) {
       if ( p[i] ) {
         MKNODE(r1,p[i],r); r = r1;
       }
     }
     return r;
   }
   
   void Ptriangleq(NODE arg,LIST *rp)
   {
     NODE ret;
   
     asir_assert(ARG0(arg),O_LIST,"sparseleq");
     ret = triangleq(BDY((LIST)ARG0(arg)));
     MKLIST(*rp,ret);
 }  }

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.76

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>