/****************************************************************/
/* file aritz.c

ARIBAS interpreter for Arithmetic
Copyright (C) 1996-2010 O.Forster

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

Address of the author

    Otto Forster
    Math. Institut der LMU
    Theresienstr. 39
    D-80333 Muenchen, Germany

Email   forster@mathematik.uni-muenchen.de
WWW     http://www.mathematik.uni-muenchen.de
*/
/****************************************************************/
/*
** aritz.c
** functions for polynomials
** and for arithmetic in GF(2**n)
**
** date of last change
**
** 2002-04-07:  created
** 2003-03-05:  gf2n functions
** 2007-04-04:  gf2X functions
** 2007-09-08:  bugfix in gf2X_mod
** 2007-09-18:  gf2polsquare
** 2007-10-01:  gf2X_divide
** 2010-02-24:  ZnX functions
*/
#include "common.h"

#define GF2XARITH
// #define ZnXARITH
// #define POLYARITH
/*-----------------------------------------------------------------*/
/* field extension Fp[sqrt(D)] */
typedef struct {
    word2 *pp;
    int plen;
    word2 *D;
    int dlen;
} FP2D;

typedef struct {
    word2 *xx;
    int xlen;
    word2 *yy;
    int ylen;
} PAIRXY;

/*-----------------------------------------------------------------*/
/* setbit and testbit suppose that vv is an array of word2 */
#define setbit(vv,i)    vv[(i)>>4] |= (1 << ((i)&0xF))
#define testbit(vv,i)   (vv[(i)>>4] & (1 << ((i)&0xF)))
/*-----------------------------------------------------------------*/
#define MULTFLAG    0
#define DIVFLAG     1
#define MODFLAG     2
#define MODNFLAG    4
#define DDIVFLAG    (DIVFLAG | MODFLAG)
/*-----------------------------------------------------------------*/

PUBLIC void iniaritz    (void);

PUBLIC truc gf2nzero, gf2none;
PUBLIC truc gf2nintsym, gf2n_sym;
#ifdef POLYARITH
PUBLIC truc polmultsym, polNmultsym;
PUBLIC truc polmodsym, polNmodsym, poldivsym, polNdivsym;
#endif
PUBLIC truc addgf2ns    (truc *ptr);
PUBLIC truc multgf2ns   (truc *ptr);
PUBLIC truc exptgf2n    (truc *ptr);
PUBLIC truc divgf2ns    (truc *ptr);
PUBLIC int fpSqrt   (word2 *pp, int plen, word2 *aa, int alen,
                    word2 *zz, word2 *hilf);
PUBLIC int fp2Sqrt     (word2 *pp, int plen, word2 *aa, int alen,
                word2 *zz, word2 *hilf);
PUBLIC unsigned fp_sqrt    (unsigned p, unsigned a);

#ifdef ZnXARITH
PRIVATE truc znXmultsym, znXsqsym; 
PRIVATE truc znXddivsym, znXdivsym, znXmodsym, znXgcdsym;
PRIVATE truc znXmodpowsym;
#endif

PRIVATE truc Fgf2nint       (void);

#ifdef ZnXARITH
PRIVATE truc FznXmult       (void);
PRIVATE truc FznXsquare     (void);
PRIVATE truc FznXdivide     (void);
PRIVATE truc FznXdiv        (void);
PRIVATE truc FznXmod        (void);
PRIVATE truc FznXgcd        (void);
PRIVATE truc FznXmodpow     (void);
PRIVATE truc znXpolmult     (truc *mptr, truc *argptr);
PRIVATE truc znXpolsquare   (truc *mptr, truc *argptr);
PRIVATE truc znXpolmodpow   (truc *mptr, truc *FF, truc *exptr, truc *GG);
PRIVATE truc znXpoldiv      (truc *mptr, truc *argptr, int mode);
PRIVATE truc znXpolmod      (truc *mptr, truc *argptr);
PRIVATE truc znXpolgcd      (truc *mptr, truc *argptr);
PRIVATE truc znXnormalize   (truc *mptr, truc *GG, int glen);
PRIVATE int znXredraw       (truc *mptr, truc *GG, int glen);
PRIVATE int znXsquare0      (truc *mptr, truc *FF, int len1, truc *PP);
PRIVATE int znXmult0        (truc *mptr, truc *FF, int len1,
                               truc *GG,int len2, truc *PP);
PRIVATE int znXmod0        (truc *mptr, truc *FF, int flen,
                               truc *GG, int glen);
PRIVATE truc znXdivmodsymb  (int mode);
PRIVATE int chkznXmultargs  (truc sym, truc *argptr);
#endif

#ifdef POLYARITH
PRIVATE truc Fpolmult       (void);
PRIVATE truc FpolNmult      (void);
PRIVATE truc Fpolmod        (void);
PRIVATE truc FpolNmod       (void);
PRIVATE truc Fpoldiv        (void);
PRIVATE truc FpolNdiv       (void);
PRIVATE int chkpolmultargs  (truc sym, truc *argptr);
PRIVATE int chkpoldivargs   (truc sym, truc *argptr);
PRIVATE truc multintpols    (truc *argptr, int mode);
PRIVATE truc modintpols     (truc *argptr, int mode);
#endif


PRIVATE int gf2polmod   (word2 *x, int n, word2 *y, int m);
PRIVATE int gf2polmult  (word2 *x, int n, word2 *y, int m, word2 *z);
PRIVATE int gf2poldivide (word2 *x, int n, word2 *y, int m, word2 *z, 
                          int *rlenptr);
PRIVATE int gf2poldiv   (word2 *x, int n, word2 *y, int m, word2 *z);
PRIVATE int gf2ninverse (word2 *x, int n, word2 *z, word2 *uu);
PRIVATE int gf2npower   (word2 *x, int n, word2 *y, int m,
                    word2 *z, word2 *hilf);
PRIVATE int gf2polsquare    (word2 *x, int n, word2 *z);
PRIVATE int gf2polmodpow    (word2 *x, int n, word2 *y, int m,
                    word2 *f, int flen, word2 *z, word2 *hilf);
PRIVATE int gf2polgcd   (word2 *x, int n, word2 *y, int m);
PRIVATE int gf2polgcdx  (word2 *x, int n, word2 *y, int m,
                    word2 *z, int *zlenptr, word2 *hilf);
PRIVATE int gf2polirred (word2 *x, int n, word2 *y, word2 *hilf);
PRIVATE int gf2polirred1 (word2 *x, int n, word2 *y, word2 *hilf);
PRIVATE int gf2ntrace   (word2 *x, int n);
PRIVATE int shiftleft1  (word2 *x, int n);
PRIVATE int bitxorshift (word2 *x, int n, word2 *y, int m, int s);
PRIVATE unsigned gf2polfindirr  (int n);

PRIVATE truc gf2ndegsym, gf2npolsym, gf2ninisym, gf2ntrsym, maxgf2nsym;
PRIVATE truc Fgf2ninit  (void);
PRIVATE truc Fgf2ndegree    (void);
PRIVATE truc Fgf2nfieldpol  (void);
PRIVATE truc Fgf2ntrace (void);
PRIVATE truc Fmaxgf2n   (void);
PRIVATE int gf2nmod (word2 *x, int n);

PRIVATE truc gf2Xmulsym, gf2Xsqsym;
PRIVATE truc gf2Xddivsym, gf2Xdivsym, gf2Xmodsym, gf2Xgcdsym;
PRIVATE truc gf2Xmpowsym, gf2Xprimsym;
PRIVATE truc Fgf2Xmult   (void);
PRIVATE truc Fgf2Xsquare (void);
PRIVATE truc Fgf2Xdivide (void);
PRIVATE truc Fgf2Xdiv    (void);
PRIVATE truc Fgf2Xmod    (void);
PRIVATE truc Fgf2Xgcd    (void);
PRIVATE truc Fgf2Xmodpow    (void);
PRIVATE truc Fgf2Xprimtest  (void);

/*----------------------------------------------------*/
PRIVATE void fp2Dmult (FP2D *pfp2D, PAIRXY *pZ1, PAIRXY *pZ2, word2 *hilf);
PRIVATE void fp2Dsquare (FP2D *pfp2D, PAIRXY *pZ, word2 *hilf);
PRIVATE void fp2Dpower (FP2D *pfp2D, PAIRXY *pZ, word2 *ex, int exlen,
                        word2 *hilf);

PRIVATE long nonresdisc (word2 *pp, int plen, word2 *aa, int alen,
                        word2 *hilf);

PRIVATE int fpSqrt58    (word2 *pp, int plen, word2 *aa, int alen,
                    word2 *zz, word2 *hilf);
PRIVATE int fpSqrt14    (word2 *pp, int plen, word2 *aa, int alen,
                    word2 *zz, word2 *hilf);
PRIVATE unsigned fp_sqrt14  (unsigned p, unsigned a);
PRIVATE void fp2pow     (unsigned p, unsigned D, unsigned *uu, unsigned n);

PRIVATE truc Ffpsqrt  (void);

PRIVATE truc fpsqrtsym;

/* #define NAUSKOMM */
#ifdef NAUSKOMM
PRIVATE truc gggsym, gg1sym, gg2sym;
PRIVATE truc Fggg   (void);
PRIVATE truc Fgg1   (void);
PRIVATE truc Fgg2   (void);
#endif

/*------------------------------------------------------------------*/
PUBLIC void iniaritz()
{
    word2 x[1];

    fpsqrtsym = newsymsig("gfp_sqrt", sFBINARY, (wtruc)Ffpsqrt, s_2);

    gf2nzero   = mk0gf2n(x,0);
    x[0] = 1;
    gf2none    = mk0gf2n(x,1);

    gf2nintsym = newsym   ("gf2nint",   sTYPESPEC, gf2nzero);
    gf2n_sym   = new0symsig("gf2nint",  sFBINARY, (wtruc)Fgf2nint, s_1);
    gf2ntrsym  = newsymsig("gf2n_trace",sFBINARY, (wtruc)Fgf2ntrace, s_1);
    gf2ninisym = newsymsig("gf2n_init", sFBINARY, (wtruc)Fgf2ninit, s_1);
    gf2ndegsym = newsymsig("gf2n_degree", sFBINARY, (wtruc)Fgf2ndegree, s_0);
    gf2npolsym = newsymsig("gf2n_fieldpol",sFBINARY,(wtruc)Fgf2nfieldpol,s_0);
    maxgf2nsym = newsymsig("max_gf2nsize",sFBINARY, (wtruc)Fmaxgf2n, s_0);

#ifdef GF2XARITH
    gf2Xmulsym = newsymsig("gf2X_mult", sFBINARY, (wtruc)Fgf2Xmult, s_2);
    gf2Xsqsym  = newsymsig("gf2X_square", sFBINARY, (wtruc)Fgf2Xsquare, s_1);
    gf2Xddivsym= newsymsig("gf2X_divide", sFBINARY, (wtruc)Fgf2Xdivide, s_2);
    gf2Xdivsym = newsymsig("gf2X_div", sFBINARY, (wtruc)Fgf2Xdiv, s_2);
    gf2Xmodsym = newsymsig("gf2X_mod", sFBINARY, (wtruc)Fgf2Xmod, s_2);
    gf2Xgcdsym = newsymsig("gf2X_gcd", sFBINARY, (wtruc)Fgf2Xgcd, s_2);
    gf2Xmpowsym = newsymsig("gf2X_modpower", sFBINARY, (wtruc)Fgf2Xmodpow, s_3);
    gf2Xprimsym = newsymsig("gf2X_primetest",sFBINARY,(wtruc)Fgf2Xprimtest,s_1);
#endif /* GF2XARITH */

#ifdef ZnXARITH
    znXmultsym  = newsymsig("ZnX_mult",  sFBINARY, (wtruc)FznXmult, s_3);
    znXsqsym    = newsymsig("ZnX_square",sFBINARY, (wtruc)FznXsquare, s_2);
    znXddivsym  = newsymsig("ZnX_divide",sFBINARY, (wtruc)FznXdivide, s_3);
    znXdivsym   = newsymsig("ZnX_div",   sFBINARY, (wtruc)FznXdiv, s_3);
    znXmodsym   = newsymsig("ZnX_mod",   sFBINARY, (wtruc)FznXmod, s_3);
    znXgcdsym   = newsymsig("ZnX_gcd",   sFBINARY, (wtruc)FznXgcd, s_3);
    znXmodpowsym= newsymsig("ZnX_modpower",sFBINARY, (wtruc)FznXmodpow,s_4);
#endif
#ifdef POLYARITH
    polmultsym = newsymsig("pol_mult",  sFBINARY, (wtruc)Fpolmult, s_2);
    polNmultsym= newintsym("pol_mult() mod", sFBINARY,(wtruc)FpolNmult);
    polmodsym  = newsymsig("pol_mod", sFBINARY, (wtruc)Fpolmod, s_2);
    polNmodsym = newintsym("pol_mod() mod", sFBINARY,(wtruc)FpolNmod);
    poldivsym  = newsymsig("pol_div", sFBINARY, (wtruc)Fpoldiv, s_2);
    polNdivsym = newintsym("pol_div() mod", sFBINARY,(wtruc)FpolNdiv);
#endif /* POLYARITH */

#ifdef NAUSKOMM
    gggsym = newsymsig("ggg", sFBINARY, (wtruc)Fggg, s_2);
    gg1sym = newsymsig("gg1", sFBINARY, (wtruc)Fgg1, s_2);
    gg2sym = newsymsig("gg2", sFBINARY, (wtruc)Fgg2, s_3);
#endif
}
/*-------------------------------------------------------------------*/
PRIVATE truc Ffpsqrt()
{
    word2 *pp, *aa, *hilf;
    int plen, alen, len, sign;

    if(chkints(fpsqrtsym,argStkPtr-1,2) == aERROR)
        return(brkerr());
    plen = bigref(argStkPtr-1,&pp,&sign);
    if(plen == 0 || (pp[0] & 1) == 0 || (plen == 1 && pp[0] <= 2)) {
        error(fpsqrtsym,err_oddprim,argStkPtr[-1]);
        return brkerr();
    }
    else if(plen > scrbufSize/16) {
        error(fpsqrtsym,err_ovfl,voidsym);
        return brkerr();
    }
    aa = AriScratch;
    alen = bigretr(argStkPtr,aa,&sign);
    if(sign)
        alen = modnegbig(aa,alen,pp,plen,AriBuf);
    else if(alen >= plen)
        alen = modbig(aa,alen,pp,plen,AriBuf);

    hilf = AriScratch + plen + 2;
    len = fpSqrt(pp,plen,aa,alen,AriBuf,hilf);
    if(len < 0) {
        error(scratch("gfp_sqrt(p,a)"),
        "p not prime or a not a square mod p",voidsym);
        return brkerr();
    }
    return mkint(0,AriBuf,len);
}
/*-------------------------------------------------------------------*/
#ifdef NAUSKOMM
/*-------------------------------------------------------------------*/
PRIVATE truc Fggg()
{
#if 1
    word2 *pp, *aa, *hilf;
    size_t N;
    int plen, alen, len, sign;

    if(chkints(gggsym,argStkPtr-1,2) == aERROR)
        return(brkerr());
    aa = AriScratch;
    plen = bigref(argStkPtr-1,&pp,&sign);
    alen = bigretr(argStkPtr,aa,&sign);
    N = 2*plen + alen;
    if(N > scrbufSize/16) {
        error(gggsym,err_ovfl,voidsym);
        return brkerr();
    }
    hilf = AriScratch + N;

    len = fp2Sqrt(pp,plen,aa,alen,AriBuf,hilf);
    if(len < 0) {
        error(gggsym,"sqrt mod p*p failed",voidsym);
        return brkerr();
    }
    return mkint(0,AriBuf,len);
#else
    return zero;
#endif
}
/*-------------------------------------------------------------------*/
PRIVATE truc Fgg1()
{
    word2 *pp, *aa, *hilf;
    size_t N;
    int plen, alen, len, sign;

    if(chkints(gg1sym,argStkPtr-1,2) == aERROR)
        return(brkerr());
    aa = AriScratch;
    plen = bigref(argStkPtr-1,&pp,&sign);
    alen = bigretr(argStkPtr,aa,&sign);
    N = plen + alen;
    if(N > scrbufSize/12) {
        error(gg1sym,err_ovfl,voidsym);
        return brkerr();
    }
    hilf = AriScratch + N;
    if(sign)
        alen = modnegbig(aa,alen,pp,plen,hilf);

    len = fpSqrt14(pp,plen,aa,alen,AriBuf,hilf);
    if(len < 0) {
        error(gg1sym,"sqrt mod p failed",voidsym);
        return brkerr();
    }
    return mkint(0,AriBuf,len);
}
/*-------------------------------------------------------------------*/
/*
** gg2(p,D,c) calculates (c + sqrt D)**(p+1)/2 in Fp[sqrt D]
** and returns its x-coordinate
*/
PRIVATE truc Fgg2()
{
    word2 *pp, *D, *ex, *xx, *yy, *hilf;
    int N, plen, dlen, exlen, xlen, sign;
    FP2D fp2D;
    PAIRXY Z;

    if(chkints(gg1sym,argStkPtr-2,3) == aERROR)
        return(brkerr());
    D = hilf = AriScratch;
    plen = bigref(argStkPtr-2,&pp,&sign);
    dlen = bigretr(argStkPtr-1,D,&sign);
    fp2D.pp = pp;
    fp2D.plen = plen;
    fp2D.D = D;
    fp2D.dlen = dlen;

    xx = AriBuf;
    N = plen + dlen + 2;
    ex = hilf + 2*N;
    yy = hilf + 4*N;
    hilf += 5*N;

    xlen = bigretr(argStkPtr,xx,&sign);
    Z.xx = xx;
    Z.xlen = xlen;
    Z.yy = yy; yy[0] = 1;
    Z.ylen = 1;
    cpyarr(pp,plen,ex);
    exlen = incarr(ex,plen,1);
    exlen = shiftarr(ex,exlen,-1);
    fp2Dpower(&fp2D,&Z,ex,exlen,hilf);
    xlen = Z.xlen;

    return mkint(0,xx,xlen);
}
/*-------------------------------------------------------------------*/
#endif /* NAUSKOMM */
/*-----------------------------------------------------------------*/
/*
** Hypothesis: (pp,plen) an odd prime, (aa, alen) a QR mod (pp,plen)
** Function calculates a square root (zz,zlen) of (aa,alen)
** (aa, alen) is reduced mod (pp,plen)
** space in zz must be at least 2*plen
** Return value is zlen
** In case of error, -1 is returned
*/
PUBLIC int fpSqrt(pp,plen,aa,alen,zz,hilf)
word2 *pp, *aa, *zz, *hilf;
int plen, alen;
{
    word2 *ex, *uu, *vv;
    int m8, exlen, zlen, ulen, vlen;

    if((plen < 1) || (pp[0] & 1) != 1)
        return -1;

    if(cmparr(pp,plen,aa,alen) <= 0) {
        alen = modbig(aa,alen,pp,plen,hilf);
    }
    if(!alen)
        return 0;

    m8 = (pp[0] & 0x7);
    if(m8 == 5) {
        return fpSqrt58(pp,plen,aa,alen,zz,hilf);
    }
    else if(m8 == 1) {
        return fpSqrt14(pp,plen,aa,alen,zz,hilf);
    }

    /******** else p = 3 mod 4 ********/
    ex = hilf;
    uu = hilf + plen + 2;
    vv = hilf + 3*plen + 4;
    hilf += 5*plen + 6;

    cpyarr(pp,plen,ex);
    exlen = shiftarr(ex,plen,-2);   /* ex = (p-3)/4 */
    ulen = modpower(aa,alen,ex,exlen,pp,plen,uu,hilf);  /* a**((p-3)/4) */
    zlen = modmultbig(uu,ulen,aa,alen,pp,plen,zz,hilf); /* a**((p+1)/4 */
    vlen = modmultbig(uu,ulen,zz,zlen,pp,plen,vv,hilf); /* a**((p-1)/2 */
    if(vv[0] != 1 || vlen != 1)
        return -1;
    return zlen;
}
/*-----------------------------------------------------------------*/
/*
** Hypothesis: (pp,plen) an odd prime = 5 mod 8,
** (aa, alen) is a QR mod (pp,plen)
** Function calculates a square root (zz,zlen) of (aa,alen)
** Return value is zlen
** In case of error, -1 is returned
*/
PRIVATE int fpSqrt58(pp,plen,aa,alen,zz,hilf)
word2 *pp, *aa, *zz, *hilf;
int plen, alen;
{
    word2 *ex, *uu, *vv, *ww;
    int zlen, exlen, ulen, vlen, wlen, cmp;

    ex = hilf;
    uu = hilf + plen + 2;
    vv = hilf + 3*plen + 4;
    ww = hilf + 5*plen + 6;
    hilf += 7*plen + 8;

    cpyarr(pp,plen,ex);
    exlen = shiftarr(ex,plen,-3);  /* ex = (p - 5)/8 */
    vlen = modpower(aa,alen,ex,exlen,pp,plen,vv,hilf);  /* v = a**((p-5)/8) */
    ulen = modmultbig(vv,vlen,aa,alen,pp,plen,uu,hilf); /* u = a**((p+3)/8) */
    wlen = modmultbig(uu,ulen,vv,vlen,pp,plen,ww,hilf); /* w = a**((p-1)/4) */
    if(ww[0] == 1 && wlen == 1) {
         cpyarr(uu,ulen,zz);
         zlen = ulen;
    }
    else {
        wlen = incarr(ww,wlen,1);
        cmp = cmparr(ww,wlen,pp,plen);
        if(cmp != 0)
            return -1;
        exlen = shiftarr(ex,exlen,1);
        exlen = incarr(ex,exlen,1);     /* ex = (p - 1)/4 */
        ww[0] = 2; wlen = 1;
        vlen = modpower(ww,wlen,ex,exlen,pp,plen,vv,hilf);
        zlen = modmultbig(uu,ulen,vv,vlen,pp,plen,ww,hilf);
        cpyarr(ww,zlen,zz);
    }
    if((zz[0] & 1) == 1)
        zlen = sub1arr(zz,zlen,pp,plen);
    return zlen;
}
/*-----------------------------------------------------------------*/
/*
** Hypothesis: (pp,plen) an odd prime = 1 mod 4,
** (aa, alen) is a QR mod (pp,plen)
** Function calculates a square root (zz,zlen) of (aa,alen)
** Return value is zlen
** In case of error, -1 is returned
*/
PRIVATE int fpSqrt14(pp,plen,aa,alen,zz,hilf)
word2 *pp, *aa, *zz, *hilf;
int plen, alen;
{
    long c;
    word2 *ex, *D, *xx, *yy;
    int exlen, dlen, xlen, zlen, cmp;
    FP2D fp2D;
    PAIRXY Z;

    c = nonresdisc(pp,plen,aa,alen,hilf);
    if(c < 0)
        return -1;
    xx = zz;
    yy = hilf;
    D = hilf + 2*plen + 2;
    ex = hilf + 4*plen + 4;
    hilf += 5*plen + 6;

    xlen = long2big(c,xx);
    Z.xx = xx;
    Z.xlen = xlen;
    yy[0] = 1;
    Z.yy = yy;
    Z.ylen = 1;

    dlen = multbig(xx,xlen,xx,xlen,D,hilf);     /* c**2 */
    cmp = cmparr(D,dlen,aa,alen);
    if(cmp < 0) {
        dlen = sub1arr(D,dlen,aa,alen);
        dlen = modnegbig(D,dlen,pp,plen,hilf);
    }
    else {
        dlen = subarr(D,dlen,aa,alen);
        dlen = modbig(D,dlen,pp,plen,hilf);
    }
    fp2D.pp = pp;
    fp2D.plen = plen;
    fp2D.D = D;
    fp2D.dlen = dlen;
    cpyarr(pp,plen,ex);
    exlen = incarr(ex,plen,1);
    exlen = shiftarr(ex,exlen,-1);
    fp2Dpower(&fp2D,&Z,ex,exlen,hilf);
    if(Z.ylen != 0)
        return -1;
    else {
        zlen = Z.xlen;
        if((zz[0] & 1) == 1)
            zlen = sub1arr(zz,zlen,pp,plen);
        return zlen;
    }
}
/*---------------------------------------------------------------*/
/*
** returns square root of a mod p, where p is a prime
** Hypothesis: jac(a,p) = 1.
** p and a should be 16-bit numbers.
*/
PUBLIC unsigned fp_sqrt(p,a)
unsigned p,a;
{
    if((p & 3) == 3)
        return(modpow(a,(p+1)/4,p));
    else
        return(fp_sqrt14(p,a));
}
/*---------------------------------------------------------------*/
/*
** returns square root of a mod p, where p is a prime = 1 mod 4.
** Hypothesis: jac(a,p) = 1.
** p and a should be 16-bit numbers.
*/
PRIVATE unsigned fp_sqrt14(p,a)
unsigned p,a;
{
    word4 c;
    unsigned D, u;
    unsigned uu[2];

    a = a % p;
    a = p - a;
    for(c=1; c < p; c++) {
        D = (unsigned)((c*c + a) % p);
        if(jac(D,p) == -1)
            break;
    }
    uu[0] = (unsigned)c;
    uu[1] = 1;
    fp2pow(p,D,uu,(p+1)/2);
    u = uu[0];
    if(u & 1)
        u = p-u;
    return u;
}
/*---------------------------------------------------------------*/
/*
** calculates uu**n in the field Fp(sqrt(D))
** Hypothesis: jac(D,p) = -1,
** p 16-bit prime
** (uu[0],uu[1]) is destructively replaced by result
*/
PRIVATE void fp2pow(p,D,uu,n)
unsigned p,D;
unsigned *uu;
unsigned n;
{
    word4 x,x0,y,y0,X,Y;

    if(n == 0) {
        uu[0] = 1;
        uu[1] = 0;
        return;
    }
    x = uu[0]; y = uu[1];
    X = 1; Y = 0;
    while(n > 1) {
        if(n & 1) {
            x0 = X;
            y0 = (Y*y) % p;
            /*
            ** X = (X*x + D*y0) % p;
            ** Y = (x0*y + Y*x) % p;
            */
            X *= x;    X %= p;
            X += D*y0; X %= p;
            Y *= x;    X %= p;
            Y += x0*y; Y %= p;
        }
        x0 = x;
        y0 = (y*y) % p;
        /*
        ** x = (x*x + D*y0) % p;
        ** y = (2*x0*y) % p;
        */
        x *= x;    x %= p;
        x += D*y0; x %= p;
        y *= x0;   y %= p;
        y += y;    y %= p;
        n >>= 1;
    }
    x0 = X;
    y0 = (Y*y) % p;
    /*
    ** uu[0] = (X*x + D*y0) % p;
    ** uu[1] = (X*y + Y*x) % p;
    */
    X *= x; X %= p;
    X += D*y0;
    uu[0] = X % p;
    Y *= x;
    Y += x0*y;
    uu[1] = Y % p;
}
/*-----------------------------------------------------------------*/
/*
** Calculates a square root of (aa,alen) mod (pp,plen)**2
** Hypothesis: pp odd prime, jacobi(aa,pp) = 1
*/
/*
    z := fp_sqrt(p,a);
    xi := (z*z - a) div p;
    eta := mod_inverse(2*z,p);
    delta := xi*eta mod p;
    z := z - delta*p;
    return (z mod p**2);
*/
PUBLIC int fp2Sqrt(pp,plen,aa,alen,zz,hilf)
word2 *pp, *aa, *zz, *hilf;
int plen, alen;
{
    word2 *xi, *eta, *delta, *ww;
    int m, xilen, elen, dlen, zlen, rlen, wlen, cmp, sign;

    m = 2*plen + 2;
    xi = hilf;
    eta = xi + m;
    delta = eta + m;
    ww = delta + m;
    hilf = ww + (alen >= m ? alen + 2: m);

    cpyarr(aa,alen,ww);
    wlen = modbig(ww,alen,pp,plen,hilf);
    zlen = fpSqrt(pp,plen,ww,wlen,zz,hilf);
    if(zlen < 0)    /* error */
        return zlen;
    xilen = multbig(zz,zlen,zz,zlen,xi,hilf);
    cmp = cmparr(xi,xilen,aa,alen);
    if(cmp >= 0) {
        xilen = subarr(xi,xilen,aa,alen);
        sign = 0;
    }
    else {
        xilen = sub1arr(xi,xilen,aa,alen);
        sign = MINUSBYTE;
    }
    xilen = divbig(xi,xilen,pp,plen,ww,&rlen,hilf);
    if(sign) {
        xilen = modnegbig(ww,xilen,pp,plen,hilf);
    }
    cpyarr(ww,xilen,xi);
        /* xi := (z*z - a) div p */
    cpyarr(zz,zlen,ww);
    elen = shiftarr(ww,zlen,1);
    elen = modinverse(ww,elen,pp,plen,eta,hilf);
        /* eta = mod_inverse(2*z,p) */
    dlen = modmultbig(xi,xilen,eta,elen,pp,plen,delta,hilf);
        /* delta := xi*eta mod p */
    wlen = multbig(delta,dlen,pp,plen,ww,hilf);
    cmp = cmparr(zz,zlen,ww,wlen);
    if(cmp >= 0) {
        zlen = subarr(zz,zlen,ww,wlen);
        sign = 0;
    }
    else {
        zlen = sub1arr(zz,zlen,ww,wlen);
        sign = MINUSBYTE;
    }
        /* z := z - delta*p, sign! */
    wlen = multbig(pp,plen,pp,plen,ww,hilf);
    if(sign == 0)
        zlen = modbig(zz,zlen,ww,wlen,hilf);
    else {
        zlen = modnegbig(zz,zlen,ww,wlen,hilf);
    }
    return zlen;
}
/*-----------------------------------------------------------------*/
/*
** returns a number c such that jacobi(c*c - (aa,alen),(pp,plen)) = -1
** In case of error (possibly (pp,plen) not prime) returns -1
*/
PRIVATE long nonresdisc(pp,plen,aa,alen,hilf)
word2 *pp, *aa, *hilf;
int plen, alen;
{
    word4 c,v;
    word2 *xx, *yy;
    int k, vlen, xlen, cmp, sign, res;
    unsigned u;

    if(alen > plen)
        alen = modbig(aa,alen,pp,plen,hilf);
    if(!alen)
        return -1;

    xx = hilf;
    hilf += (plen >= alen ? plen : alen) + 2;
    yy = hilf;
    hilf += plen + 2;

    u = 0x1000;
    if(plen == 1 && pp[0] < u) {
        u = pp[0];
    }
    c = random2(u);
    for(k=1; k<=60000; k++,c++) {
        v = c*c;
        vlen = long2big(v,xx);
        cmp = cmparr(aa,alen,xx,vlen);
        if(cmp > 0) {
            xlen = sub1arr(xx,vlen,aa,alen);
            sign = MINUSBYTE;
        }
        else if(cmp < 0) {
            xlen = subarr(xx,vlen,aa,alen);
            sign = 0;
        }
        else
            continue;
        cpyarr(pp,plen,yy);
        res = jacobi(sign,xx,xlen,yy,plen,hilf);
        if(res < 0)
            return c;
        if((k & 0xFF) == 0) {
            if(!rabtest(pp,plen,hilf))
                break;
        }
    }
    return -1;
}
/*-----------------------------------------------------------------*/
/*
** Destructively calculates *pZ1 := (*pZ1) * (*pZ2)
** in the field given by *pfp2D
*/
PRIVATE void fp2Dmult(pfp2D,pZ1,pZ2,hilf)
FP2D *pfp2D;
PAIRXY *pZ1, *pZ2;
word2 *hilf;
{
    word2 *x0, *zz, *ww;
    int zlen, plen, wlen, x0len;

    plen = pfp2D->plen;
    x0 = hilf;
    zz = hilf + plen + 2;
    ww = hilf + 3*plen + 4;
    hilf += 5*plen + 6;

    /* x0 := x1 */
    x0len = pZ1->xlen;
    cpyarr(pZ1->xx,x0len,x0);
    /* x1 := x1*x2 + y1*y2*D */
    zlen = multbig(pZ1->yy,pZ1->ylen,pZ2->yy,pZ2->ylen,zz,hilf);
    zlen = modbig(zz,zlen,pfp2D->pp,plen,hilf);
    wlen = multbig(zz,zlen,pfp2D->D,pfp2D->dlen,ww,hilf);
    zlen = multbig(pZ1->xx,pZ1->xlen,pZ2->xx,pZ2->xlen,zz,hilf);
    wlen = addarr(ww,wlen,zz,zlen);
    wlen = modbig(ww,wlen,pfp2D->pp,plen,hilf);
    cpyarr(ww,wlen,pZ1->xx);
    pZ1->xlen = wlen;
    /* y1 := x0*y2 + y1*x2 */
    wlen = multbig(x0,x0len,pZ2->yy,pZ2->ylen,ww,hilf);
    zlen = multbig(pZ1->yy,pZ1->ylen,pZ2->xx,pZ2->xlen,zz,hilf);
    wlen = addarr(ww,wlen,zz,zlen);
    wlen = modbig(ww,wlen,pfp2D->pp,plen,hilf);
    cpyarr(ww,wlen,pZ1->yy);
    pZ1->ylen = wlen;
}
/*-----------------------------------------------------------------*/
/*
** Destructively calculates *pZ := (*pZ)**2
** in the field given by *pfp2D
*/
PRIVATE void fp2Dsquare(pfp2D,pZ,hilf)
FP2D *pfp2D;
PAIRXY *pZ;
word2 *hilf;
{
    word2 *x0, *zz, *ww;
    int zlen, plen, wlen, x0len;

    plen = pfp2D->plen;
    x0 = hilf;
    zz = hilf + plen + 2;
    ww = hilf + 3*plen + 4;
    hilf += 5*plen + 6;

    /* x0 := x */
    x0len = pZ->xlen;
    cpyarr(pZ->xx,x0len,x0);
    /* x := x*x + y*y*D */
    zlen = multbig(pZ->yy,pZ->ylen,pZ->yy,pZ->ylen,zz,hilf);
    zlen = modbig(zz,zlen,pfp2D->pp,plen,hilf);
    wlen = multbig(zz,zlen,pfp2D->D,pfp2D->dlen,ww,hilf);
    zlen = multbig(pZ->xx,pZ->xlen,pZ->xx,pZ->xlen,zz,hilf);
    wlen = addarr(ww,wlen,zz,zlen);
    wlen = modbig(ww,wlen,pfp2D->pp,plen,hilf);
    cpyarr(ww,wlen,pZ->xx);
    pZ->xlen = wlen;
    /* y := 2*x0*y */
    zlen = multbig(x0,x0len,pZ->yy,pZ->ylen,zz,hilf);
    zlen = shiftarr(zz,zlen,1);
    zlen = modbig(zz,zlen,pfp2D->pp,plen,hilf);
    cpyarr(zz,zlen,pZ->yy);
    pZ->ylen = zlen;
}
/*-----------------------------------------------------------------*/
/*
** Destructively calculates *pZ := (*pZ)**(ex,exlen)
** in the field given by *pfp2D
*/
PRIVATE void fp2Dpower(pfp2D,pZ,ex,exlen,hilf)
FP2D *pfp2D;
PAIRXY *pZ;
word2 *ex, *hilf;
int exlen;
{
    PAIRXY Z0;
    word2 *xx, *yy;
    int plen, bitl, k;
    int allowintr;

    if(exlen == 0) {
        pZ->xx[0] = 1;
        pZ->xlen = 1;
        pZ->ylen = 0;
        return;
    }

    plen = pfp2D->plen;
    xx = hilf;
    yy = hilf + 2*plen + 2;
    hilf += 4*plen + 4;

    /* z0 := z */
    cpyarr(pZ->xx,pZ->xlen,xx);
    cpyarr(pZ->yy,pZ->ylen,yy);
    Z0.xx = xx; Z0.yy = yy;
    Z0.xlen = pZ->xlen;
    Z0.ylen = pZ->ylen;
    bitl = (exlen-1)*16 + bitlen(ex[exlen-1]);
    allowintr = (plen >= 16 && (exlen + plen >= 256) ? 1 : 0);
    for(k=bitl-2; k>=0; k--) {
        fp2Dsquare(pfp2D,pZ,hilf);
        if(testbit(ex,k))
            fp2Dmult(pfp2D,pZ,&Z0,hilf);
        if(allowintr && INTERRUPT) {
            setinterrupt(0);
            reset(err_intr);
        }
    }
    return;
}
/*------------------------------------------------------------------*/
#ifdef ZnXARITH
/*------------------------------------------------------------------*/
PRIVATE truc FznXmult()
{
    int type;

    if(chkintnz(znXmultsym,argStkPtr-2) == aERROR)
        return brkerr();
    type = chkznXmultargs(znXmultsym,argStkPtr-1);
    if(type == aERROR)
        return brkerr(); 
    return znXpolmult(argStkPtr-2,argStkPtr-1);
}
/*------------------------------------------------------------------*/
PRIVATE truc FznXsquare()
{
    int type;

    if(chkintnz(znXsqsym,argStkPtr-1) == aERROR)
        return brkerr();
    type = *FLAGPTR(argStkPtr);
    if(type != fVECTOR) {
        error(znXsqsym,err_vect,*argStkPtr);
        return brkerr();
    }
    if(chkintvec(znXsqsym,argStkPtr) == aERROR)
        return brkerr();

    return znXpolsquare(argStkPtr-1,argStkPtr); 
}
/*------------------------------------------------------------------*/
/*
** ZnX_modpower(p,F,ex,G)
*/
PRIVATE truc FznXmodpow()
{
    int type;

    if(chkintnz(znXmodpowsym,argStkPtr-3) == aERROR)
        return brkerr();
    if(chkint(znXmodpowsym,argStkPtr-1) == aERROR)
        return brkerr();
    type = *FLAGPTR(argStkPtr-2);
    if(type != fVECTOR) {
        error(znXmodpowsym,err_vect,argStkPtr[-2]);
        return brkerr();
    }
    if(chkintvec(znXmodpowsym,argStkPtr-2) == aERROR)
        return brkerr();
    type = *FLAGPTR(argStkPtr);
    if(type != fVECTOR) {
        error(znXmodpowsym,err_vect,argStkPtr[0]);
        return brkerr();
    }
    if(chkintvec(znXmodpowsym,argStkPtr) == aERROR)
        return brkerr();
	return znXpolmodpow(argStkPtr-3,argStkPtr-2,argStkPtr-1,argStkPtr);
}
/*------------------------------------------------------------------*/
PRIVATE truc FznXdivide()
{
    int type, mode;

    if(chkintnz(znXdivsym,argStkPtr-2) == aERROR)
        return brkerr();
    type = chkznXmultargs(znXddivsym,argStkPtr-1);
    if(type == aERROR)
        return brkerr(); 
    mode = DDIVFLAG;
    return znXpoldiv(argStkPtr-2,argStkPtr-1,mode);
}
/*------------------------------------------------------------------*/
PRIVATE truc FznXdiv()
{
    int type, mode;

    if(chkintnz(znXdivsym,argStkPtr-2) == aERROR)
        return brkerr();
    type = chkznXmultargs(znXdivsym,argStkPtr-1);
    if(type == aERROR)
        return brkerr(); 
    mode = DIVFLAG;
    return znXpoldiv(argStkPtr-2,argStkPtr-1,mode);
}
/*------------------------------------------------------------------*/
PRIVATE truc FznXmod()
{
    int type;

    if(chkintnz(znXmodsym,argStkPtr-2) == aERROR)
        return brkerr();
    type = chkznXmultargs(znXmodsym,argStkPtr-1);
    if(type == aERROR)
        return brkerr(); 
    return znXpolmod(argStkPtr-2,argStkPtr-1);
}
/*------------------------------------------------------------------*/
PRIVATE truc FznXgcd()
{
    int type;

    if(chkintnz(znXgcdsym,argStkPtr-2) == aERROR)
        return brkerr();
    type = chkznXmultargs(znXgcdsym,argStkPtr-1);
    if(type == aERROR)
        return brkerr(); 
    return znXpolgcd(argStkPtr-2,argStkPtr-1);
}
/*------------------------------------------------------------------*/
PRIVATE truc znXpolsquare(mptr,argptr)
truc *mptr; 
truc *argptr;
{
    truc *workarr, *outarr, *ptr, *ptr1, *wptr;
    truc obj;
    int len, len1, k, i;
    unsigned mlen;

    len1 = *VECLENPTR(argptr);
    if(len1 == 0)
        return mkvect0(0);

    mlen = aribufSize/3 - 6;
    if(*FLAGPTR(mptr) == fBIGNUM && *BIGLENPTR(mptr) >= mlen)
        goto ovflexit;
    if(*mptr == zero) {
        error(znXmodsym,err_pint,*mptr);
        return brkerr();        
    }

    /* now len1 >= 1 */
    workarr = arrayStkPtr+1;
    if(!ARRAYspace(3*len1-1)) {
        error(znXsqsym,err_memev,voidsym);
        return brkerr();
    }
    ptr = VECTORPTR(argptr);
    wptr = workarr;
    for(i=0; i<len1; i++) {      /* vector stored in workarr[] */
        if(*FLAGPTR(ptr) == fBIGNUM && *BIGLENPTR(ptr) >= mlen)
            goto ovflexit;
        *wptr++ = *ptr++;
    }
    /* initialize result array */
    ptr = outarr = workarr + len1;
    len = 2*len1 - 1;
    for(i=0; i<len; i++)
        *ptr++ = zero;

    len = znXsquare0(mptr,workarr,len1,outarr);

    obj = mkvect0(len);
    ptr = VECTOR(obj);
    ptr1 = outarr;
    for(k=0; k<len; k++)
        *ptr++ = *ptr1++;
    arrayStkPtr = workarr-1;
    return obj;

  ovflexit:
    arrayStkPtr = workarr-1;
    error(znXsqsym,err_ovfl,voidsym);
    return(brkerr());
}
/*------------------------------------------------------------------*/
PRIVATE truc znXpolmodpow(mptr,Fptr,exptr,Gptr)
truc *mptr, *Fptr, *exptr, *Gptr;
{
    truc *FF, *GG, *PP, *TT, *ptr, *ptr1, *ptr2;
    truc *arraySavePtr;
    truc obj, res;
    word2 *aa, *bb, *xx, *yy, *nn;
    int i, k, n, m, m2, bitl, freelen;   
    int flen, glen, plen, tlen, exlen, exlen2; 
    int sign, sign1, sign2;
    unsigned mlen, offsbb;
    
    if(numposneg(exptr) < 0) {
        error(znXmodpowsym,err_p0int,*exptr);
        return brkerr();        
    }
    if(*exptr == zero) {
        obj = mkvect0(1);
		ptr = VECTOR(obj);
        *ptr = constone;
        return obj;
    }
    mlen = aribufSize/3 - 6;
    if(*FLAGPTR(mptr) == fBIGNUM && *BIGLENPTR(mptr) >= mlen)
        goto ovflexit;
    if(*mptr == zero) {
        error(znXmodpowsym,err_pint,*mptr);
        return brkerr();        
    }
  
    flen = *VECLENPTR(Fptr);
    if(!flen)
        return mkvect0(0);
    glen = *VECLENPTR(Gptr);
    if(!glen) {
        error(znXmodpowsym,err_div,voidsym);
        return brkerr();
    }
    arraySavePtr = arrayStkPtr;
    freelen = ARRAYmemavail();
    if((freelen <= 5*glen) || (freelen <= flen + glen)) {
        error(znXmodpowsym,err_memev,voidsym);
        return brkerr();
    }
    GG = arraySavePtr+1;
    FF = GG + glen;    
    arrayStkPtr = arraySavePtr + (flen+glen);
    ptr1 = GG;
    ptr2 = VECTORPTR(Gptr);
    for(k=0; k<glen; k++) {     /* store polynomial G */
        if(*FLAGPTR(ptr2) == fBIGNUM && *BIGLENPTR(ptr2) >= mlen)
            goto ovflexit;
        *ptr1++ = *ptr2++;
    }
    ptr1 = FF;
    ptr2 = VECTORPTR(Fptr);
    for(k=0; k<flen; k++) {     /* store polynomial F */
        if(*FLAGPTR(ptr2) == fBIGNUM && *BIGLENPTR(ptr2) >= mlen)
            goto ovflexit;
        *ptr1++ = *ptr2++;
    }
    if(GG[glen-1] != constone) { /* normalize polynomial G */
        res = znXnormalize(mptr,GG,glen);
        if (res == zero) {
            error(znXmodpowsym,
                "leading coeff of module not invertible ",GG[glen-1]);
            return brkerr();
        }
    }
/**************mm**************/
    else {		/* reduce big coeffs of G modulo *mptr */
        aa = AriBuf;
        offsbb = (mlen + 6) & 0xFFFE;
        bb = AriBuf + offsbb;
        m2 = bigretr(mptr,aa,&sign2);

        for(k=0; k<glen-1; k++) {
            m = bigref(GG+k, &yy, &sign1);
            if(m > m2) {
                 cpyarr(yy,m,bb);
                 n = modbig(bb,m,aa,m2,AriScratch);
                 obj = mkint(sign1,bb,n);
                 GG[k] = obj;
            }
        }
    }
    if(flen >= glen) {
        flen = znXmod0(mptr,FF,flen,GG,glen);
        arrayStkPtr = arraySavePtr + (flen+glen);
    }
    PP = arrayStkPtr+1;
    TT = PP + glen;
    arrayStkPtr += 3*glen;
    ptr = PP;
    for(i=0; i<3*glen; i++)
        *ptr++ = zero;   
    exlen = bigref(exptr,&xx,&sign);
    exlen2 = (exlen+1)/2;
    if(SAVEspace(exlen2) == NULL) {
        error(znXmodpowsym,err_memev,voidsym);
        return brkerr();
    }
    else {
        nn = (word2*)saveStkPtr;
        cpyarr(xx,exlen,nn);
    }
    cpy4arr(FF,flen,PP);
    plen = flen;
    bitl = (exlen-1)*16 + bitlen(nn[exlen-1]);
    for(n=bitl-2; n>=0; n--) {
		/* TT := PP**2; TT := TT mod GG; PP := TT; */    
        tlen = znXsquare0(mptr,PP,plen,TT);
        plen = znXmod0(mptr,TT,tlen,GG,glen);
        cpy4arr(TT,plen,PP);

        if(testbit(nn,n)) {
            /* TT := PP*FF; TT := TT mod GG; PP := TT; */
            tlen = znXmult0(mptr,FF,flen,PP,plen,TT);
            plen = znXmod0(mptr,TT,tlen,GG,glen);
            cpy4arr(TT,plen,PP);
        }
        if(!(n & 0xF) && INTERRUPT) {
            setinterrupt(0);
            reset(err_intr);
        }
    }
    obj = mkvect0(plen);
    ptr1 = VECTOR(obj);
    ptr2 = PP;
    for(k=0; k<plen; k++)
        *ptr1++ = *ptr2++;

    SAVEnpop(exlen2);
    arrayStkPtr = arraySavePtr;
    return obj;

  ovflexit:
    arrayStkPtr = arraySavePtr;
    error(znXmodpowsym,err_ovfl,voidsym);
    return(brkerr());
}
/*------------------------------------------------------------------*/
PRIVATE truc znXnormalize(mptr,GG,glen)
truc *mptr, *GG;
int glen;
{
    word2 *aa, *bb, *yy, *zz;
    truc obj;
    int n, m, m2, k, alen;
    int sign, signL, sign1, sign2;
    unsigned mlen, offsbb;

    if(GG[glen-1] == constone) 
        return constone;

    aa = AriBuf;
    mlen = aribufSize/3 - 6;
    offsbb = (mlen + 6) & 0xFFFE;
    bb = AriBuf + offsbb;

    n = bigretr(GG+glen-1,bb,&signL);
    m2 = bigref(mptr,&zz,&sign2);
    alen = modinverse(bb,n,zz,m2,aa,AriScratch);
    if (alen==0) {
        return zero;
    }
    obj = mkint(signL,aa,alen);
    WORKpush(obj);
    for(k=0; k<glen-1; k++) {
        m = bigref(GG+k, &yy, &sign1);
        n = multbig(yy,m,aa,alen,bb,AriScratch);
        sign = (signL == sign1 ? 0 : MINUSBYTE);
        m2 = bigref(mptr,&zz,&sign2);
        n = modbig(bb,n,zz,m2,AriScratch);
        obj = mkint(sign,bb,n);
        GG[k] = obj;
    }
    GG[glen-1] = constone;
    return WORKretr();
}
/*------------------------------------------------------------------*/
/* 
** reduce big coeffs of GG modulo *mptr 
*/
PRIVATE int znXredraw(mptr,GG,glen)
truc *mptr, *GG;
int glen;
{
    word2 *aa, *bb, *yy;
    truc obj;
    int n, m, m2, k;
    int sign1, sign2;
    unsigned mlen, offsbb;

    aa = AriBuf;
    mlen = aribufSize/3 - 6;
    offsbb = (mlen + 6) & 0xFFFE;

    bb = AriBuf + offsbb;
    m2 = bigretr(mptr,aa,&sign2);

    for(k=0; k<glen; k++) {
        m = bigref(GG+k, &yy, &sign1);
        if(m > m2) {
             cpyarr(yy,m,bb);
             n = modbig(bb,m,aa,m2,AriScratch);
             obj = mkint(sign1,bb,n);
             GG[k] = obj;
        }
    }
    return glen;
}
/*------------------------------------------------------------------*/
/*
** Squares the polynomial (FF,len1) 
** in the polynomial ring Z/(*mptr)
** and stores the result in the array PP, which
** must have length = 2*len1-1
*/
PRIVATE int znXsquare0(mptr,FF,len1,PP)
truc *mptr, *FF, *PP;
int len1;
{
    word2 *x, *y, *zz, *aa, *hilf;
    truc obj;
    int len, k, i, j0, j1;
    int n1, n2, n3, n, m, sign, sign1, sign2, sign3;
    unsigned mlen, offshilf;

    if(len1 <= 0)
        return 0;
    zz = AriBuf;
    n3 = bigretr(mptr,zz,&sign3);
    mlen = aribufSize/3 - 6;
    aa = AriBuf + ((mlen + 6) & 0xFFFE);
    offshilf = (scrbufSize/2) & 0xFFFE;

    len = 2*len1 - 1;
    for(k=0; k<len; k++) {
        hilf = AriScratch + offshilf;
        n = 0; sign = 0;
        j0 = (k < len1 ? 0 : k+1-len1);
        j1 = (k+1)/2;
        for(i=j0; i<j1; i++) {
            n1 = bigref(FF+i,&x,&sign1);
            n2 = bigref(FF+(k-i),&y,&sign2);
            m = multbig(x,n1,y,n2,AriScratch,hilf);
            sign1 = (sign1 == sign2 ? 0 : MINUSBYTE);
            n = addsarr(aa,n,sign,AriScratch,m,sign1,&sign);
        }
        n = shlarr(aa,n,1);
        if ((k&1) == 0) {
            n1 = bigref(FF+(k/2),&x,&sign1);
            m = multbig(x,n1,x,n1,AriScratch,hilf);
            sign1 = 0;
            n = addsarr(aa,n,sign,AriScratch,m,sign1,&sign);
        }
        n = modbig(aa,n,zz,n3,hilf);
        if(n && (sign != sign3)) {
            n = sub1arr(aa,n,zz,n3);
            sign = sign3;
        }
        obj = mkint(sign,aa,n);
        PP[k] = obj;
    }
    while(len > 0 && PP[len-1] == zero)
        len--;
    return len;
}
/*------------------------------------------------------------------*/
/*
** Multiplies the polynomial (FF,len1) by (GG,len2) 
** in the polynomial ring Z/(*mptr)
** and stores the result in the array PP, which
** must have length = 2*(len1+len2) - 1
*/
PRIVATE int znXmult0(mptr,FF,len1,GG,len2,PP)
truc *mptr, *FF, *GG, *PP;
int len1, len2;
{
    truc obj;
    word2 *x, *y, *zz, *aa, *hilf;
    int len, k, i, j0, j1;
    int n1, n2, n3, n, m, sign, sign1, sign2, sign3;
    unsigned mlen, offshilf;

    zz = AriBuf;
    n3 = bigretr(mptr,zz,&sign3);
    mlen = aribufSize/3 - 6;
    aa = AriBuf + ((mlen + 6) & 0xFFFE);
    offshilf = (scrbufSize/2) & 0xFFFE;

    len = len1 + len2 - 1;
    for(k=0; k<len; k++) {
        hilf = AriScratch + offshilf;
        /* AriScratch might have changed after garbage collection */
        n = 0; sign = 0;
        j0 = (k < len2 ? 0 : k+1-len2);
        j1 = (k < len1 ? k : len1-1);
        for(i=j0; i<=j1; i++) {
            n1 = bigref(FF+i,&x,&sign1);
            n2 = bigref(GG+(k-i),&y,&sign2);
            m = multbig(x,n1,y,n2,AriScratch,hilf);
            sign1 = (sign1 == sign2 ? 0 : MINUSBYTE);
            n = addsarr(aa,n,sign,AriScratch,m,sign1,&sign);
        }
        n = modbig(aa,n,zz,n3,hilf);
        if(n && (sign != sign3)) {
            n = sub1arr(aa,n,zz,n3);
            sign = sign3;
        }
        obj = mkint(sign,aa,n);
        PP[k] = obj;
    }
    while(len > 0 && PP[len-1] == zero)
        len--;
    return len;
}
/*------------------------------------------------------------------*/
/*
** multiplies two integer polynomials given by argptr[0] and argptr[1]
** and mods them out modulo *mptr
*/
PRIVATE truc znXpolmult(mptr,argptr)
truc *mptr;
truc *argptr;
{
    truc *ptr1, *ptr2;
    truc *workarr, *w2ptr, *outarr, *ptr, *wptr;
    truc obj;
    int len, len1, len2, k, i;
    unsigned mlen;

    len = *VECLENPTR(argptr);
    len2 = *VECLENPTR(argptr+1);
    if(len >= len2) {
        len1 = len;
        ptr1 = argptr;
        ptr2 = argptr + 1;
    }
    else {
        len1 = len2;
        len2 = len;
        ptr1 = argptr + 1;
        ptr2 = argptr;
    }
    /* now len1 >= len2, lenk = length of vector *ptrk */
    if(len2 == 0)
        return mkvect0(0);

    /* now len2 >= 1 */
    workarr = arrayStkPtr+1;
    if(!ARRAYspace(2*(len1+len2)-1)) {
        error(znXmultsym,err_memev,voidsym);
        return brkerr();
    }
    mlen = aribufSize/3 - 6;
    if(*FLAGPTR(mptr) == fBIGNUM && *BIGLENPTR(mptr) >= mlen)
        goto ovflexit;

    ptr = VECTORPTR(ptr1);
    wptr = workarr;
    for(i=0; i<len1; i++) {      /* first vector stored in workarr[] */
        if(*FLAGPTR(ptr) == fBIGNUM && *BIGLENPTR(ptr) >= mlen)
            goto ovflexit;
        *wptr++ = *ptr++;
    }
    ptr = VECTORPTR(ptr2);
    wptr = w2ptr = workarr + len1;
    for(k=0; k<len2; k++) {     /* store second polynomial in w2ptr[] */
        if(*FLAGPTR(ptr) == fBIGNUM && *BIGLENPTR(ptr) >= mlen)
            goto ovflexit;
        *wptr++ = *ptr++;
    }
    ptr = outarr = w2ptr + len2;
    len = len1 + len2 - 1;
    for(k=0; k<len; k++)        /* initialize result array */ 
        *ptr++ = zero;
 
    len = znXmult0(mptr,workarr,len1,w2ptr,len2,outarr);

    obj = mkvect0(len);
    ptr = VECTOR(obj);
    wptr = outarr;
    for(k=0; k<len; k++)
        *ptr++ = *wptr++;

    arrayStkPtr = workarr-1;
    return obj;

  ovflexit:
    arrayStkPtr = workarr-1;
    error(znXmultsym,err_ovfl,voidsym);
    return(brkerr());
}
/*------------------------------------------------------------------*/
PRIVATE truc znXdivmodsymb(mode)
int mode;
{
    if (mode == MODFLAG)
        return znXmodsym;
    else if (mode == DIVFLAG)
        return znXdivsym;
    else if (mode == DDIVFLAG)
        return znXddivsym;
    else
        return voidsym;
}
/*------------------------------------------------------------------*/
/*
** division of integer polynomial given by argptr[0] by argptr[1],
** modded out modulo *mptr
*/
PRIVATE truc znXpoldiv(mptr,argptr,mode)
truc *mptr;
truc *argptr;
int mode;
{
    truc *workarr, *w1ptr, *w2ptr, *leadptr, *ptr1, *ptr2;
    truc *vptr;
    truc obj;
    word2 *yy, *zz, *aa, *bb;
    unsigned mlen, offsbb, offshilf;
    int sign, sign1, sign2, sign3, signL;
    int j, k, m, m1, m2, n, len1, len2, len3, len4;
    int leadcorr = 0;

    len1 = *VECLENPTR(argptr);
    len2 = *VECLENPTR(argptr+1);
    if(!len2) {
        error(znXdivmodsymb(mode),err_div,voidsym);
        return brkerr();
    }

    if(len2 > len1) {
        if (mode == MODFLAG)
            return *argptr;
        else
            obj = mkvect0(0);
        if (mode == DIVFLAG)
            return obj;
        else { /* mode == DDIVFLAG */
            WORKpush(obj);
            obj = mkvect0(2);
            vptr = VECTOR(obj);
            vptr[0] = WORKretr();
            vptr[1] = *argptr;
            return obj;
        }
    }

    mlen = aribufSize/3 - 6;
    if(*FLAGPTR(mptr) == fBIGNUM && *BIGLENPTR(mptr) >= mlen)
        goto ovflexit;
    if(*mptr == zero) {
        error(znXdivmodsymb(mode),err_pint,*mptr);
        return brkerr();        
    }

    workarr = arrayStkPtr+1;
    if(!ARRAYspace(len1 + len2)) {
        error(znXdivmodsymb(mode),err_memev,voidsym);
        return brkerr();
    }
    w2ptr = workarr + len1;

    offsbb = (mlen + 6) & 0xFFFE;
    offshilf = (scrbufSize/2) & 0xFFFE;

    ptr1 = workarr;
    ptr2 = VECTORPTR(argptr);
    for(k=0; k<len1; k++) {     /* store first polynomial */
        if(*FLAGPTR(ptr2) == fBIGNUM && *BIGLENPTR(ptr2) >= mlen)
            goto ovflexit;
        *ptr1++ = *ptr2++;
    }
    ptr1 = w2ptr;
    ptr2 = VECTORPTR(argptr+1);
    for(k=0; k<len2; k++) {     /* store second polynomial */
        if(*FLAGPTR(ptr2) == fBIGNUM && *BIGLENPTR(ptr2) >= mlen)
            goto ovflexit;
        *ptr1++ = *ptr2++;
    }
    aa = AriBuf;
    bb = AriBuf + offsbb;

    if(w2ptr[len2-1] != constone) {
        leadcorr = 1;
        leadptr = w2ptr + len2 - 1;
        n = bigretr(leadptr,bb,&signL);
        m2 = bigref(mptr,&zz,&sign2);
        m = modinverse(bb,n,zz,m2,aa,AriScratch);
        if (m==0) {
            error(znXdivmodsymb(mode),
                "leading coeff must be invertible mod n",w2ptr[len2-1]);
            return brkerr();
        }
        obj = mkint(signL,aa,m);
        *leadptr = obj;
        for(k=0; k<len2-1; k++) {
            n = bigref(leadptr,&zz,&signL);
            m = bigref(w2ptr+k, &yy, &sign1);
            n = multbig(yy,m,zz,n,bb,AriScratch);
            sign = (signL == sign1 ? 0 : MINUSBYTE);
            m2 = bigref(mptr,&zz,&sign2);
            n = modbig(bb,n,zz,m2,AriScratch);
            obj = mkint(sign,bb,n);
            w2ptr[k] = obj;
        }
    }

    len3 = len1 - len2 + 1;
    for(k=len3-1; k>=0; k--) {
        n = bigretr(workarr+len2-1+k,aa,&sign);
        m2 = bigref(mptr,&zz,&sign2);
        n = modbig(aa,n,zz,m2,AriScratch);
        if(!n)
            continue;
        for(j=0; j<=len2-2; j++) {
            m = bigref(w2ptr+j,&yy,&sign1);
            if(!m)
                continue;
            m = multbig(aa,n,yy,m,AriScratch,AriScratch+offshilf);
            sign1 = (sign == sign1 ? MINUSBYTE : 0);
            /* sign of the negative product */
            m1 = bigretr(workarr+k+j, bb, &sign2);
            m = addsarr(bb,m1,sign2,AriScratch,m,sign1,&sign3);
            obj = mkint(sign3,bb,m);
            workarr[k+j] = obj;
        }
    }
    if (mode & MODFLAG) {
        len4 = len2 - 1;
        for(k=0; k<len4; k++) {
            n = bigretr(workarr+k,aa,&sign);
            m2 = bigref(mptr,&zz,&sign2);
            n = modbig(aa,n,zz,m2,AriScratch);
            if(n && (sign != sign2)) {
                n = sub1arr(aa,n,zz,m2);
                sign = sign2;
            }
            obj = mkint(sign,aa,n);
            workarr[k] = obj;
        }
        while(len4>0 && workarr[len4-1] == zero)
            len4--;
        obj = mkvect0(len4);
        ptr1 = VECTOR(obj);
        ptr2 = workarr;
        for(k=0; k<len4; k++)
            *ptr1++ = *ptr2++;
        WORKpush(obj);
    }
    if (mode & DIVFLAG) {
        w1ptr = workarr + len2 - 1;
        if (leadcorr) {
            m = bigretr(leadptr,aa,&signL);
            for(k=0; k<len3; k++) {
                n = bigref(w1ptr+k,&yy,&sign);
                if (!n)
                    continue;
                n = multbig(yy,n,aa,m,bb,AriScratch);
                sign = (signL == sign ? 0 : MINUSBYTE);
                m2 = bigref(mptr,&zz,&sign2);
                n = modbig(bb,n,zz,m2,AriScratch);
                if(n && (sign != sign2)) {
                    n = sub1arr(bb,n,zz,m2);
                    sign = sign2;
                }
                obj = mkint(sign,bb,n);
                w1ptr[k] = obj;
            }
        }
        else {
            for(k=0; k<len3; k++) {
                n = bigretr(w1ptr+k,aa,&sign);
                m2 = bigref(mptr,&zz,&sign2);
                n = modbig(aa,n,zz,m2,AriScratch);
                if(n && (sign != sign2)) {
                    n = sub1arr(aa,n,zz,m2);
                    sign = sign2;
                }
                obj = mkint(sign,aa,n);
                w1ptr[k] = obj;
            }
        }
        while(len3>0 && w1ptr[len3-1] == zero)
            len3--;
        obj = mkvect0(len3);
        ptr1 = VECTOR(obj);
        ptr2 = w1ptr;
        for(k=0; k<len3; k++)
            *ptr1++ = *ptr2++;
        WORKpush(obj);
    }
    if (mode == DDIVFLAG) {
        obj = mkvect0(2);
        vptr = VECTOR(obj);
        vptr[0] = WORKretr();
        vptr[1] = WORKretr();
    }
    else {
        obj = WORKretr();
    }
    arrayStkPtr = workarr-1;
    return obj;

  ovflexit:
    arrayStkPtr = workarr-1;
    error(znXdivmodsymb(mode),err_ovfl,voidsym);
    return(brkerr());
}
/*------------------------------------------------------------------*/
/*
** polynomial argptr[0] modulo argptr[1],
** over the ring Z/(*mptr)
*/
PRIVATE truc znXpolmod(mptr,argptr)
truc *mptr;
truc *argptr;
{
    truc *workarr, *w2ptr, *ptr1, *ptr2;
    truc obj;
    word2 *yy, *zz, *aa, *bb;
    unsigned mlen, offsbb;
    int sign, sign1, sign2, signL;
    int k, m, m2, n, len1, len2, len;

    len1 = *VECLENPTR(argptr);
    len2 = *VECLENPTR(argptr+1);
    if(!len2) {
        error(znXmodsym,err_div,voidsym);
        return brkerr();
    }
    if(len2 > len1) {
        return *argptr;
    }
    mlen = aribufSize/3 - 6;
    if(*FLAGPTR(mptr) == fBIGNUM && *BIGLENPTR(mptr) >= mlen)
        goto ovflexit;
    if(*mptr == zero) {
        error(znXmodsym,err_pint,*mptr);
        return brkerr();        
    }

    workarr = arrayStkPtr+1;
    if(!ARRAYspace(len1 + len2)) {
        error(znXmodsym,err_memev,voidsym);
        return brkerr();
    }
    w2ptr = workarr + len1;

    ptr1 = workarr;
    ptr2 = VECTORPTR(argptr);
    for(k=0; k<len1; k++) {     /* store first polynomial */
        if(*FLAGPTR(ptr2) == fBIGNUM && *BIGLENPTR(ptr2) >= mlen)
            goto ovflexit;
        *ptr1++ = *ptr2++;
    }
    ptr1 = w2ptr;
    ptr2 = VECTORPTR(argptr+1);
    for(k=0; k<len2; k++) {     /* store second polynomial */
        if(*FLAGPTR(ptr2) == fBIGNUM && *BIGLENPTR(ptr2) >= mlen)
            goto ovflexit;
        *ptr1++ = *ptr2++;
    }

    if(w2ptr[len2-1] != constone) {
        /* normalize second polynomial */
        aa = AriBuf;
        offsbb = (mlen + 6) & 0xFFFE;
        bb = AriBuf + offsbb;

        n = bigretr(w2ptr+len2-1,bb,&signL);
        m2 = bigref(mptr,&zz,&sign2);
        m = modinverse(bb,n,zz,m2,aa,AriScratch);
        if (m==0) {
            error(znXmodsym,
                "leading coeff must be invertible mod n",w2ptr[len2-1]);
            return brkerr();
        }
        obj = mkint(signL,aa,m);
        WORKpush(obj);
        for(k=0; k<len2-1; k++) {
            n = bigref(workStkPtr,&zz,&signL);
            m = bigref(w2ptr+k, &yy, &sign1);
            n = multbig(yy,m,zz,n,bb,AriScratch);
            sign = (signL == sign1 ? 0 : MINUSBYTE);
            m2 = bigref(mptr,&zz,&sign2);
            n = modbig(bb,n,zz,m2,AriScratch);
            obj = mkint(sign,bb,n);
            w2ptr[k] = obj;
        }
        w2ptr[len2-1] = constone;
        WORKpop();
    }

    len = znXmod0(mptr,workarr,len1,w2ptr,len2);

    obj = mkvect0(len);
    ptr1 = VECTOR(obj);
    ptr2 = workarr;
    for(k=0; k<len; k++)
        *ptr1++ = *ptr2++;
    arrayStkPtr = workarr-1;
    return obj;

  ovflexit:
    arrayStkPtr = workarr-1;
    error(znXmodsym,err_ovfl,voidsym);
    return(brkerr());
}
/*------------------------------------------------------------------*/
/*
** gcd of the polynomials argptr[0], argptr[1],
** over the field Z/(*mptr)
** (*mptr) should be non-zero and prime!
*/
PRIVATE truc znXpolgcd(mptr,argptr)
truc *mptr;
truc *argptr;
{
    truc *w1ptr, *w2ptr, *ptr1, *ptr2, *temptr;
    truc *arraySavePtr;
    truc obj;
    word2 *yy, *zz, *aa, *bb;
    unsigned mlen, offsbb;
    int sign, sign1, sign2, signL;
    int k, m, m2, n, len1, len2, templen;

    len1 = *VECLENPTR(argptr);
    len2 = *VECLENPTR(argptr+1);
    
    mlen = aribufSize/3 - 6;
    if(*FLAGPTR(mptr) == fBIGNUM && *BIGLENPTR(mptr) >= mlen)
        goto ovflexit0;
    if(*mptr == zero) {
        error(znXgcdsym,err_pint,*mptr);
        return brkerr();        
    }

    arraySavePtr = arrayStkPtr;
    if(!ARRAYspace(len1 + len2)) {
        error(znXgcdsym,err_memev,voidsym);
        return brkerr();
    }
    w1ptr = arraySavePtr + 1;
    w2ptr = w1ptr + len1;

    /* store first polynomial */
    ptr1 = w1ptr;
    ptr2 = VECTORPTR(argptr);
    for(k=0; k<len1; k++) {
        if(*FLAGPTR(ptr2) == fBIGNUM && *BIGLENPTR(ptr2) >= mlen)
            goto ovflexit;
        *ptr1++ = *ptr2++;
    }
    while((len1 > 0) && (w1ptr[len1-1] == zero)) /* delete leading zeros */
        len1--; 

    /* store second polynomial */
    ptr1 = w2ptr;
    ptr2 = VECTORPTR(argptr+1);
    for(k=0; k<len2; k++) {     
        if(*FLAGPTR(ptr2) == fBIGNUM && *BIGLENPTR(ptr2) >= mlen)
            goto ovflexit;
        *ptr1++ = *ptr2++;
    }
    while((len2 > 0) && (w2ptr[len2-1] == zero)) /* delete leading zeros */
        len2--; 

    if((len1==0) && (len2==0)) {
        arrayStkPtr = arraySavePtr;
        return mkvect0(0);
    }
    else if(len1==0) {
        ;
    }
    else if((len2==0) || (len1 < len2)) {
        temptr = w1ptr; templen = len1;
        w1ptr = w2ptr;  len1 = len2;
        w2ptr = temptr; len2 = templen;
    }
    while(1) { 
        if(w2ptr[len2-1] != constone) {
            /* normalize second polynomial */
            aa = AriBuf;
            offsbb = (mlen + 6) & 0xFFFE;
            bb = AriBuf + offsbb;

            n = bigretr(w2ptr+len2-1,bb,&signL);
            m2 = bigref(mptr,&zz,&sign2);
            m = modinverse(bb,n,zz,m2,aa,AriScratch);
            if (m==0) {
                error(znXgcdsym,
                    "module p possibly not prime",*mptr);
                return brkerr();
            }
            obj = mkint(signL,aa,m);
            WORKpush(obj);
            for(k=0; k<len2-1; k++) {
                n = bigref(workStkPtr,&zz,&signL);
                m = bigref(w2ptr+k, &yy, &sign1);
                n = multbig(yy,m,zz,n,bb,AriScratch);
                sign = (signL == sign1 ? 0 : MINUSBYTE);
                m2 = bigref(mptr,&zz,&sign2);
                n = modbig(bb,n,zz,m2,AriScratch);
                obj = mkint(sign,bb,n);
                w2ptr[k] = obj;
            }
            w2ptr[len2-1] = constone;
            WORKpop();
        }
        if(len1==0) 
            break;    
        len1 = znXmod0(mptr,w1ptr,len1,w2ptr,len2);
        if(len1==0) 
            break;    
        temptr = w1ptr; templen = len1;
        w1ptr = w2ptr;  len1 = len2;
        w2ptr = temptr; len2 = templen;
    }
    obj = mkvect0(len2);
    ptr1 = VECTOR(obj);
    ptr2 = w2ptr;
    for(k=0; k<len2; k++)
        *ptr1++ = *ptr2++;
    arrayStkPtr = arraySavePtr;
    return obj;

  ovflexit:
    arrayStkPtr = arraySavePtr;
  ovflexit0:
    error(znXgcdsym,err_ovfl,voidsym);
    return(brkerr());
}
/*-----------------------------------------------------------------*/
/*
** Destructively calculates (FF mod GG), where FF and GG
** are polynomials over the ring Z/(*mptr)
** It is supposed that the leading coefficient of GG equals 1
** Return value is the length of the reduced pol FF
*/
PRIVATE int znXmod0(mptr,FF,flen,GG,glen)
truc *mptr, *FF, *GG;
int flen,glen;
{
    int k, j, n, m, m1, m2, len;
    unsigned mlen, offsbb, offshilf;
    int sign, sign1, sign2, sign3;
	word2 *aa, *bb, *yy, *zz;
    truc obj;

    if(glen > flen)
        return flen;

    aa = AriBuf;
    mlen = aribufSize/3 - 6;
    offsbb = (mlen + 6) & 0xFFFE;
    bb = AriBuf + offsbb;
    offshilf = (scrbufSize/2) & 0xFFFE;

    for(k=flen-glen; k>=0; k--) {
        n = bigretr(FF+glen-1+k,aa,&sign);
        FF[glen-1+k] = zero;
        m2 = bigref(mptr,&zz,&sign2);
        n = modbig(aa,n,zz,m2,AriScratch);
        if(!n)
            continue;
        for(j=0; j<=glen-2; j++) {
            m = bigref(GG+j,&yy,&sign1);
            if(!m)
                continue;
            m = multbig(aa,n,yy,m,AriScratch,AriScratch+offshilf);
            sign1 = (sign == sign1 ? MINUSBYTE : 0);
            /* sign of the negative product */
            m1 = bigretr(FF+k+j, bb, &sign2);
            m = addsarr(bb,m1,sign2,AriScratch,m,sign1,&sign3);
            obj = mkint(sign3,bb,m);
            FF[k+j] = obj;
        }
    }
    len = glen - 1;
    for(k=0; k<len; k++) {
        n = bigretr(FF+k,aa,&sign);
        m2 = bigref(mptr,&zz,&sign2);
        n = modbig(aa,n,zz,m2,AriScratch);
        if(n && (sign != sign2)) {
            n = sub1arr(aa,n,zz,m2);
            sign = sign2;
        }
        obj = mkint(sign,aa,n);
        FF[k] = obj;
    }
    while(len>0 && FF[len-1] == zero)
        len--;
    return len;
}
/*-----------------------------------------------------------------*/
PRIVATE int chkznXmultargs(sym,argptr)
truc sym;
truc *argptr;
{
    int flg1, flg2;
    truc *ptr;

    flg1 = *FLAGPTR(argptr);
    flg2 = *FLAGPTR(argptr+1);
    if(flg1 != fVECTOR || flg2 != fVECTOR) {
        ptr = (flg1 == fVECTOR ? argptr+1 : argptr);
        return error(sym,err_vect,*ptr);
    }
    flg1 = chkintvec(sym,argptr);
    if(flg1 != aERROR)
        flg2 = chkintvec(sym,argptr+1);
    if(flg1 == aERROR || flg2 == aERROR)
        return aERROR;

    return (flg1 >= flg2 ? flg1 : flg2);
}
/*------------------------------------------------------------------*/
#endif
/*-----------------------------------------------------------------*/
#ifdef POLYARITH
/*-----------------------------------------------------------------*/
PRIVATE truc Fpolmult()
{
    int type;

    type = chkpolmultargs(polmultsym,argStkPtr-1);
    if(type == aERROR)
        return brkerr();
    if(type <= fBIGNUM) {
        return multintpols(argStkPtr-1,MULTFLAG);
    }
    else {
        error(polmultsym,err_imp,voidsym);
        return mkvect0(0);
    }
}
/*------------------------------------------------------------------*/
PRIVATE truc FpolNmult()
{
    int type;

    type = chkpolmultargs(polNmultsym,argStkPtr-2);
    if(type == aERROR || chkintnz(polNmultsym,argStkPtr) == aERROR)
        return brkerr();
    return multintpols(argStkPtr-2,MODNFLAG);
}
/*------------------------------------------------------------------*/
/*
** multiplies two integer polynomials given by argptr[0] and argptr[1]
*/
PRIVATE truc multintpols(argptr,mode)
truc *argptr;
int mode;
{
    truc *ptr1, *ptr2;
    truc *workarr, *w2ptr, *ptr, *wptr;
    struct vector *vecptr;
    truc obj;
    word2 *x, *y, *zz, *aa, *hilf;
    int len, len1, len2, k, i, j0, j1;
    int n1, n2, n3, n, m, sign, sign1, sign2, sign3;
    unsigned mlen, offshilf;

    len = *VECLENPTR(argptr);
    len2 = *VECLENPTR(argptr+1);
    if(len >= len2) {
        len1 = len;
        ptr1 = argptr;
        ptr2 = argptr + 1;
    }
    else {
        len1 = len2;
        len2 = len;
        ptr1 = argptr + 1;
        ptr2 = argptr;
    }
    /* now len1 >= len2, lenk = length of vector *ptrk */
    if(len2 == 0)
        return mkvect0(0);

    /* now len2 >= 1 */
    workarr = arrayStkPtr+1;
    if(!ARRAYspace(len1 + len2)) {
        error(polmultsym,err_memev,voidsym);
        return brkerr();
    }
    mlen = aribufSize/3 - 6;
    ptr = VECTORPTR(ptr1);
    wptr = workarr;
    for(i=0; i<len1; i++) {      /* first vector stored in workarr[] */
        if(*FLAGPTR(ptr) == fBIGNUM && *BIGLENPTR(ptr) >= mlen)
            goto ovflexit;
        *wptr++ = *ptr++;
    }
    ptr = VECTORPTR(ptr2);
    wptr = w2ptr = workarr + len1;
    for(k=0; k<len2; k++) {     /* store second polynomial */
        if(*FLAGPTR(ptr) == fBIGNUM && *BIGLENPTR(ptr) >= mlen)
            goto ovflexit;
        *wptr++ = *ptr++;
    }
    len = len1 + len2 - 1;
    obj = mkvect0(len);
    WORKpush(obj);
    if(mode & MODNFLAG) {
        zz = AriBuf;
        n3 = bigretr(argStkPtr,zz,&sign3);
        if(n3 >= mlen)
            goto ovflexit;
    }
    aa = AriBuf + ((mlen + 6) & 0xFFFE);
    offshilf = (scrbufSize/2) & 0xFFFE;
    for(k=0; k<len; k++) {
        hilf = AriScratch + offshilf;
        n = 0; sign = 0;
        j0 = (k < len2 ? 0 : k+1-len2);
        j1 = (k < len1 ? k : len1-1);
        for(i=j0; i<=j1; i++) {
            n1 = bigref(workarr+i,&x,&sign1);
            n2 = bigref(w2ptr+(k-i),&y,&sign2);
            m = multbig(x,n1,y,n2,AriScratch,hilf);
            sign1 = (sign1 == sign2 ? 0 : MINUSBYTE);
            n = addsarr(aa,n,sign,AriScratch,m,sign1,&sign);
        }
        if(mode & MODNFLAG) {
            n = modbig(aa,n,zz,n3,hilf);
            if(n && (sign != sign3)) {
                n = sub1arr(aa,n,zz,n3);
                sign = sign3;
            }
        }
        obj = mkint(sign,aa,n);
        *(VECTORPTR(workStkPtr) + k) = obj;
    }
    vecptr = VECSTRUCTPTR(workStkPtr);
    ptr = &(vecptr->ele0) + len - 1;
    while(len > 0 && *ptr-- == zero)
        len--;
    vecptr->len = len;
    obj = WORKretr();
    arrayStkPtr = workarr-1;
    return obj;
  ovflexit:
    arrayStkPtr = workarr-1;
    error(polmultsym,err_ovfl,voidsym);
    return(brkerr());
}
/*------------------------------------------------------------------*/
PRIVATE truc Fpolmod()
{
    int type;

    type = chkpoldivargs(polmodsym,argStkPtr-1);
    if(type == aERROR)
        return brkerr();

    return modintpols(argStkPtr-1,MODFLAG);
}
/*------------------------------------------------------------------*/
PRIVATE truc FpolNmod()
{
    int type;

    type = chkpoldivargs(polNmodsym,argStkPtr-2);
    if(type == aERROR)
        return brkerr();

    return modintpols(argStkPtr-2, MODFLAG | MODNFLAG);
}
/*------------------------------------------------------------------*/
PRIVATE truc Fpoldiv()
{
    int type;

    type = chkpoldivargs(poldivsym,argStkPtr-1);
    if(type == aERROR)
        return brkerr();

    return modintpols(argStkPtr-1,DIVFLAG);
}
/*------------------------------------------------------------------*/
PRIVATE truc FpolNdiv()
{
    int type;

    type = chkpoldivargs(polNdivsym,argStkPtr-2);
    if(type == aERROR)
        return brkerr();

    return modintpols(argStkPtr-2, DIVFLAG | MODNFLAG);
}
/*------------------------------------------------------------------*/
PRIVATE truc modintpols(argptr,mode)
truc *argptr;
int mode;
{
    truc *workarr, *w1ptr, *w2ptr, *ptr1, *ptr2;
    truc obj;
    word2 *yy, *zz, *aa, *bb, *hilf;
    unsigned mlen, offsbb, offshilf;
    int sign, sign1, sign2, sign3;
    int j, k, m, m1, m2, n, len1, len2, len3;
    int mode1;

    len1 = *VECLENPTR(argptr);
    len2 = *VECLENPTR(argptr+1);
    if(!len2) {
        error(polmodsym,err_div,voidsym);
        return brkerr();
    }
    ptr2 = VECTORPTR(argptr+1);
    if(ptr2[len2-1] != constone) {
        error(polmodsym,"divisor must have leading coeff = 1",ptr2[len2-1]);
        return brkerr();
    }
    if(len2 > len1)
        return(*argptr);
    else if(len2 == 1)
        return mkvect0(0);
    workarr = arrayStkPtr+1;
    if(!ARRAYspace(len1 + len2)) {
        error(polmodsym,err_memev,voidsym);
        return brkerr();
    }
    mlen = aribufSize/3 - 6;
    offsbb = (mlen + 6) & 0xFFFE;
    offshilf = (scrbufSize/2) & 0xFFFE;
    w2ptr = workarr + len1;
    ptr1 = workarr;
    ptr2 = VECTORPTR(argptr);
    for(k=0; k<len1; k++) {     /* store first polynomial */
        if(*FLAGPTR(ptr2) == fBIGNUM && *BIGLENPTR(ptr2) >= mlen)
            goto ovflexit;
        *ptr1++ = *ptr2++;
    }
    ptr1 = w2ptr;
    ptr2 = VECTORPTR(argptr+1);
    for(k=0; k<len2; k++) {     /* store second polynomial */
        if(*FLAGPTR(ptr2) == fBIGNUM && *BIGLENPTR(ptr2) >= mlen)
            goto ovflexit;
        *ptr1++ = *ptr2++;
    }
    aa = AriBuf;
    bb = AriBuf + offsbb;
    len3 = len1 - len2;
    for(k=len3; k>=0; k--) {
        n = bigretr(workarr+len2+k-1,aa,&sign);
        if(mode & MODNFLAG) {
            m2 = bigref(argStkPtr,&zz,&sign2);
            n = modbig(aa,n,zz,m2,AriScratch);
            if(n && (sign != sign2)) {
                n = sub1arr(aa,n,zz,m2);
                sign = sign2;
            }
        }
        if(!n)
            continue;
        for(j=0; j<=len2-2; j++) {
            hilf = AriScratch + offshilf;
            m = bigref(w2ptr+j,&yy,&sign1);
            if(!m)
                continue;
            m = multbig(aa,n,yy,m,AriScratch,hilf);
            sign1 = (sign == sign1 ? MINUSBYTE : 0);
            /* sign of the negative product */
            m1 = bigretr(workarr+k+j,bb,&sign2);
            m = addsarr(bb,m1,sign2,AriScratch,m,sign1,&sign3);
            obj = mkint(sign3,bb,m);
            workarr[k+j] = obj;
        }
    }
    mode1 = (mode & DDIVFLAG);
    if(mode1 == MODFLAG) {
        if(mode & MODNFLAG) {
            for(k=0; k<=len2-1; k++) {
                n = bigretr(workarr+k,aa,&sign);
                m2 = bigref(argStkPtr,&zz,&sign2);
                n = modbig(aa,n,zz,m2,AriScratch);
                if(n && (sign != sign2)) {
                    n = sub1arr(aa,n,zz,m2);
                    sign = sign2;
                }
                obj = mkint(sign,aa,n);
                workarr[k] = obj;
            }
        }
        k = len2-2;
        while(k >= 0 && workarr[k] == zero) {
            k--; len2--;
        }
        obj = mkvect0(len2-1);
        ptr1 = VECTOR(obj);
        ptr2 = workarr;
        for(k=0; k<=len2-2; k++)
            *ptr1++ = *ptr2++;
    }
    else if(mode1 == DIVFLAG) {
        w1ptr = workarr + len2 - 1;
        if(mode & MODNFLAG) {
            for(k=0; k<=len3; k++) {
                n = bigretr(w1ptr+k,aa,&sign);
                m2 = bigref(argStkPtr,&zz,&sign2);
                n = modbig(aa,n,zz,m2,AriScratch);
                if(n && (sign != sign2)) {
                    n = sub1arr(aa,n,zz,m2);
                    sign = sign2;
                }
                obj = mkint(sign,aa,n);
                w1ptr[k] = obj;
            }
        }
        while(len3>=0 && w1ptr[len3] == zero)
            len3--;
        obj = mkvect0(len3+1);
        ptr1 = VECTOR(obj);
        ptr2 = w1ptr;
        for(k=0; k<=len3; k++)
            *ptr1++ = *ptr2++;
    }
    arrayStkPtr = workarr-1;
    return obj;
  ovflexit:
    arrayStkPtr = workarr-1;
    error(polmodsym,err_ovfl,voidsym);
    return(brkerr());
}
/*------------------------------------------------------------------*/
PRIVATE int chkpolmultargs(sym,argptr)
truc sym;
truc *argptr;
{
    int flg1, flg2;
    truc *ptr;

    flg1 = *FLAGPTR(argptr);
    flg2 = *FLAGPTR(argptr+1);
    if(flg1 != fVECTOR || flg2 != fVECTOR) {
        ptr = (flg1 == fVECTOR ? argptr+1 : argptr);
        return error(sym,err_vect,*ptr);
    }
    if(sym == polmultsym) {
        flg1 = chknumvec(sym,argptr);
        if(flg1 != aERROR)
            flg2 = chknumvec(sym,argptr+1);
    }
    else {
        flg1 = chkintvec(sym,argptr);
        if(flg1 != aERROR)
            flg2 = chkintvec(sym,argptr+1);
    }
    if(flg1 == aERROR || flg2 == aERROR)
        return aERROR;

    return (flg1 >= flg2 ? flg1 : flg2);
}
/*------------------------------------------------------------------*/
PRIVATE int chkpoldivargs(sym,argptr)
truc sym;
truc *argptr;
{
    int flg1, flg2;
    truc *ptr;

    flg1 = *FLAGPTR(argptr);
    flg2 = *FLAGPTR(argptr+1);
    if(flg1 != fVECTOR || flg2 != fVECTOR) {
        ptr = (flg1 == fVECTOR ? argptr+1 : argptr);
        return error(sym,err_vect,*ptr);
    }
    flg1 = chkintvec(sym,argptr);
    if(flg1 != aERROR)
        flg2 = chkintvec(sym,argptr+1);
    if(flg1 == aERROR || flg2 == aERROR)
        return aERROR;


    return (flg1 >= flg2 ? flg1 : flg2);
}
/*------------------------------------------------------------------*/
#endif
/*******************************************************************/
typedef struct {
    int mode;
    unsigned deg;
    word2 ftail;
} GF2n_Field;

static GF2n_Field gf2nField = {1, 8, 0x1B};
static int MaxGf2n = 4099;

/*-------------------------------------------------------------*/
/*
** if k = sum(b_i * 2**i), then
** spreadbyte[k] = sum(b_i * 4**i).
*/
static word2 spreadbyte[256] = {
0x0000, 0x0001, 0x0004, 0x0005, 0x0010, 0x0011, 0x0014, 0x0015,
0x0040, 0x0041, 0x0044, 0x0045, 0x0050, 0x0051, 0x0054, 0x0055,
0x0100, 0x0101, 0x0104, 0x0105, 0x0110, 0x0111, 0x0114, 0x0115,
0x0140, 0x0141, 0x0144, 0x0145, 0x0150, 0x0151, 0x0154, 0x0155,
0x0400, 0x0401, 0x0404, 0x0405, 0x0410, 0x0411, 0x0414, 0x0415,
0x0440, 0x0441, 0x0444, 0x0445, 0x0450, 0x0451, 0x0454, 0x0455,
0x0500, 0x0501, 0x0504, 0x0505, 0x0510, 0x0511, 0x0514, 0x0515,
0x0540, 0x0541, 0x0544, 0x0545, 0x0550, 0x0551, 0x0554, 0x0555,
0x1000, 0x1001, 0x1004, 0x1005, 0x1010, 0x1011, 0x1014, 0x1015,
0x1040, 0x1041, 0x1044, 0x1045, 0x1050, 0x1051, 0x1054, 0x1055,
0x1100, 0x1101, 0x1104, 0x1105, 0x1110, 0x1111, 0x1114, 0x1115,
0x1140, 0x1141, 0x1144, 0x1145, 0x1150, 0x1151, 0x1154, 0x1155,
0x1400, 0x1401, 0x1404, 0x1405, 0x1410, 0x1411, 0x1414, 0x1415,
0x1440, 0x1441, 0x1444, 0x1445, 0x1450, 0x1451, 0x1454, 0x1455,
0x1500, 0x1501, 0x1504, 0x1505, 0x1510, 0x1511, 0x1514, 0x1515,
0x1540, 0x1541, 0x1544, 0x1545, 0x1550, 0x1551, 0x1554, 0x1555,
0x4000, 0x4001, 0x4004, 0x4005, 0x4010, 0x4011, 0x4014, 0x4015,
0x4040, 0x4041, 0x4044, 0x4045, 0x4050, 0x4051, 0x4054, 0x4055,
0x4100, 0x4101, 0x4104, 0x4105, 0x4110, 0x4111, 0x4114, 0x4115,
0x4140, 0x4141, 0x4144, 0x4145, 0x4150, 0x4151, 0x4154, 0x4155,
0x4400, 0x4401, 0x4404, 0x4405, 0x4410, 0x4411, 0x4414, 0x4415,
0x4440, 0x4441, 0x4444, 0x4445, 0x4450, 0x4451, 0x4454, 0x4455,
0x4500, 0x4501, 0x4504, 0x4505, 0x4510, 0x4511, 0x4514, 0x4515,
0x4540, 0x4541, 0x4544, 0x4545, 0x4550, 0x4551, 0x4554, 0x4555,
0x5000, 0x5001, 0x5004, 0x5005, 0x5010, 0x5011, 0x5014, 0x5015,
0x5040, 0x5041, 0x5044, 0x5045, 0x5050, 0x5051, 0x5054, 0x5055,
0x5100, 0x5101, 0x5104, 0x5105, 0x5110, 0x5111, 0x5114, 0x5115,
0x5140, 0x5141, 0x5144, 0x5145, 0x5150, 0x5151, 0x5154, 0x5155,
0x5400, 0x5401, 0x5404, 0x5405, 0x5410, 0x5411, 0x5414, 0x5415,
0x5440, 0x5441, 0x5444, 0x5445, 0x5450, 0x5451, 0x5454, 0x5455,
0x5500, 0x5501, 0x5504, 0x5505, 0x5510, 0x5511, 0x5514, 0x5515,
0x5540, 0x5541, 0x5544, 0x5545, 0x5550, 0x5551, 0x5554, 0x5555};
/*-------------------------------------------------------------------*/
/*
** Adds two gf2n_int's in ptr[0] and ptr[1]
*/
PUBLIC truc addgf2ns(ptr)
truc *ptr;
{
    word2 *y;
    int n, m, deg;
    int sign;

    n = bigretr(ptr,AriBuf,&sign);
    m = bigref(ptr+1,&y,&sign);
    deg = gf2nField.deg;
    if(deg < bit_length(AriBuf,n) || deg < bit_length(y,m)) {
        error(plussym,"gf2nint summand too big",voidsym);
        return brkerr();
    }
    n = xorbitvec(AriBuf,n,y,m);
    return(mkgf2n(AriBuf,n));
}
/*-------------------------------------------------------------------*/
/*
** Multiplies two gf2n_int's in ptr[0] and ptr[1]
*/
PUBLIC truc multgf2ns(ptr)
truc *ptr;
{
    int n, m, sign, deg;
    word2 *x, *y;

    n = bigref(ptr,&x,&sign);
    m = bigref(ptr+1,&y,&sign);
    deg = gf2nField.deg;
    if(deg < bit_length(x,n) || deg < bit_length(y,m)) {
        error(timessym,"gf2nint factor too big",voidsym);
        return brkerr();
    }
    n = gf2polmult(x,n,y,m,AriBuf);
    n = gf2nmod(AriBuf,n);
    return mkgf2n(AriBuf,n);
}
/*-------------------------------------------------------------------*/
/*
** Divide gf2nint ptr[0] by gf2nint ptr[1]
*/
PUBLIC truc divgf2ns(ptr)
truc *ptr;
{
    word2 *x, *y, *z;
    int n, m, sign, deg;

    n = bigref(ptr,&x,&sign);
    deg = gf2nField.deg;
    if(deg < bit_length(x,n)) {
        error(divfsym,"gf2nint argument too big",*ptr);
        return brkerr();
    }
    y = AriBuf;
    m = bigretr(ptr+1,y,&sign);
    if(deg < bit_length(y,m)) {
        error(divfsym,"gf2nint argument too big",ptr[1]);
        return brkerr();
    }
    z = y + m + 1;
    m = gf2ninverse(y,m,z,AriScratch);
    if(m == 0) {
        error(divfsym,err_div,voidsym);
        return brkerr();
    }
    n = gf2polmult(z,m,x,n,AriScratch);
    cpyarr(AriScratch,n,AriBuf);
    n = gf2nmod(AriBuf,n);
    return mkgf2n(AriBuf,n);
}
/*-------------------------------------------------------------------*/
/*
** gf2nint in ptr[0] is raised to power ptr[1], which may
** be a positive or negative integer
*/
PUBLIC truc exptgf2n(ptr)
truc *ptr;
{
    word2 *x, *y, *z;
    int n, m, N, deg, sign;

    n = bigref(ptr,&x,&sign);
    deg = gf2nField.deg;
    if(deg < bit_length(x,n)) {
        error(powersym,"gf2nint argument too big",*ptr);
        return brkerr();
    }
    m = bigref(ptr+1,&y,&sign);
    if(sign) {
        cpyarr(x,n,AriBuf);
        x = AriBuf;
        z = AriBuf + n + 1;
        n = gf2ninverse(AriBuf,n,z,AriScratch);
        if(n == 0) {
            error(powersym,err_div,voidsym);
            return brkerr();
        }
        else {
            cpyarr(z,n,x);
            z = AriBuf + n + 1;
        }
        if(m == 1 && y[0] == 1) {
            return mkgf2n(x,n);
        }
    }
    else if(m == 0) {
        return gf2none;
    }
    else {
        z = AriBuf;
    }
    N = gf2npower(x,n,y,m,z,AriScratch);
    return mkgf2n(z,N);
}
/*-------------------------------------------------------------------*/
/*
** Transforms object in *argStkPtr to data type gf2nint
*/
PRIVATE truc Fgf2nint()
{
    word2 *x;
    byte *bpt;
    unsigned u;
    unsigned len;
    int i, n, flg, sign;

    flg = *FLAGPTR(argStkPtr);

    if(flg == fFIXNUM || flg == fBIGNUM || flg == fGF2NINT) {
        n = bigretr(argStkPtr,AriBuf,&sign);
    }
    else if(flg == fBYTESTRING) {
        len = *STRLENPTR(argStkPtr);
        if(len >= aribufSize*2 - 2) {
            error(gf2n_sym,err_2long,mkfixnum(len));
            return(brkerr());
        }
        bpt = (byte *)STRINGPTR(argStkPtr);
        n = len / 2;
        x = AriBuf;
        for(i=0; i<n; i++) {
            u = bpt[1];
            u <<= 8;
            u += bpt[0];
            *x++ = u;
            bpt += 2;
        }
        if(len & 1) {
            *x = *bpt;
            n++;
        }
    }
    else {
        error(gf2n_sym,err_int,voidsym);
        return brkerr();
    }
    n = gf2nmod(AriBuf,n);
    return mkgf2n(AriBuf,n);
}
/*-------------------------------------------------------------------*/
PRIVATE truc Fgf2ninit()
{
    int n, m;
    unsigned u;
    word2 *x;

    if(*FLAGPTR(argStkPtr) != fFIXNUM) {
        error(gf2ninisym,err_pfix,voidsym);
        return brkerr();
    }
    n = *WORD2PTR(argStkPtr);
    if(n < 2) {
        error(gf2ninisym,"degree >= 2 expected",*argStkPtr);
        return brkerr();
    }
    else if(n > MaxGf2n) {
        error(gf2ninisym,"maximal degree is",mkfixnum(MaxGf2n));
        return brkerr();
    }
    u = gf2polfindirr(n);
    if(!u) {
        error(gf2ninisym, "no irreducible polynomial found", voidsym);
        return brkerr();
    }
    gf2nField.deg = n;
    gf2nField.ftail = u;

    m = n/16 + 1;
    x = AriBuf;
    setarr(x,m,0);
    x[0] = u;
    setbit(x,n);

    return mkint(0,x,m);
}
/*-------------------------------------------------------------------*/
PRIVATE truc Fgf2ndegree()
{
    unsigned deg = gf2nField.deg;

    return mkfixnum(deg);
}
/*-------------------------------------------------------------------*/
PRIVATE truc Fgf2nfieldpol()
{
    int n;
    unsigned deg;
    word2 *x;

    deg = gf2nField.deg;

    n = (deg+1)/16 + 1;
    x = AriBuf;
    setarr(x,n,0);
    x[0] = gf2nField.ftail;
    setbit(x,deg);
    return mkint(0,x,n);
}
/*-------------------------------------------------------------------*/
#if 0
PRIVATE truc Fgf2nparms()
{
    int mode, n;
    unsigned deg;
    word2 *x;
    truc fdeg, fpol, vec;
    truc *ptr;

    mode = gf2nField.mode;
    deg = gf2nField.deg;

    if(mode == 1) {
        n = (deg+1)/16 + 1;
        x = AriBuf;
        setarr(x,n,0);
        x[0] = gf2nField.ftail;
        setbit(x,deg);
        fpol = mkint(0,x,n);
        WORKpush(fpol);
        fdeg = mkfixnum(deg);
        vec = mkvect0(2);
        ptr = VECTOR(vec);
        ptr[0] = fdeg;
        ptr[1] = WORKretr();
        return vec;
    }
    else {
        error(gf2parmsym,err_imp,voidsym);
        return brkerr();
    }
}
#endif
/*-------------------------------------------------------------------*/
PRIVATE truc Fmaxgf2n()
{
    return mkfixnum(MaxGf2n);
}
/*-------------------------------------------------------------------*/
PRIVATE truc Fgf2ntrace()
{
    int n, t, sign;
    word2 *x;

    if(*FLAGPTR(argStkPtr) != fGF2NINT) {
        error(gf2ntrsym,"gfnint expected",*argStkPtr);
        return brkerr();
    }
    x = AriBuf;
    n = bigretr(argStkPtr,x,&sign);
    if(n == aERROR)
        return brkerr();
    if(gf2nField.deg < bit_length(x,n)) {
        error(gf2ntrsym,"gf2nint argument too big",voidsym);
        return brkerr();
    }
    t = gf2ntrace(x,n);
    return mkfixnum(t);
}
/*------------------------------------------------------------------*/
PRIVATE truc Fgf2Xmult()
{
    int n,m,len,sign;
    word2 *x, *y;

    n = bigref(argStkPtr-1,&x,&sign);
    if (n == aERROR)
        goto errexit;
    m = bigref(argStkPtr,&y,&sign);
    if (m == aERROR)
        goto errexit;
    if(n + m >= aribufSize) {
        error(gf2Xmulsym,err_ovfl,voidsym);
        return(brkerr());
    }
    else if(!n || !m)
        return(zero);
    len = gf2polmult(x,n,y,m,AriBuf);
    return mkint(0,AriBuf,len);

  errexit:
    error(gf2Xmulsym,err_intt,voidsym);
    return brkerr();
}
/*------------------------------------------------------------------*/
PRIVATE truc Fgf2Xsquare()
{
    int n,len,sign;
    word2 *x;

    n = bigref(argStkPtr,&x,&sign);
    if (n == aERROR) {
        error(gf2Xsqsym,err_intt,voidsym);
        return brkerr();
    }
    if (2*n >= aribufSize) {
        error(gf2Xmulsym,err_ovfl,voidsym);
        return(brkerr());
    }
    else if (!n)
        return zero;

    len = gf2polsquare(x,n,AriBuf);
    return mkint(0,AriBuf,len);
}
/*------------------------------------------------------------------*/
PRIVATE truc Fgf2Xdivide()
{
    int n,m,len,sign,rlen;
    word2 *x, *y;
    truc obj, vec;
    truc *vptr;

    x = AriScratch;
    n = bigretr(argStkPtr-1,x,&sign);
    if (n == aERROR)
        goto errexit;
    else if(n >= aribufSize) {
        error(gf2Xddivsym,err_ovfl,voidsym);
        return(brkerr());
    }
    m = bigref(argStkPtr,&y,&sign);
    if (m == aERROR)
        goto errexit;
    else if(m == 0) {
        error(gf2Xddivsym,err_div,voidsym);
        return brkerr();
    }
    len = gf2poldivide(x,n,y,m,AriBuf,&rlen);
    y = AriBuf + len;
    cpyarr(x,rlen,y);

    obj = mkint(0,AriBuf,len);
    WORKpush(obj);
    obj = mkint(0,y,rlen);
    WORKpush(obj);
    vec = mkvect0(2);
    vptr = VECTOR(vec);
    vptr[1] = WORKretr();
    vptr[0] = WORKretr();
    return vec;

  errexit:
    error(gf2Xddivsym,err_intt,voidsym);
    return brkerr();
}
/*------------------------------------------------------------------*/
PRIVATE truc Fgf2Xdiv()
{
    int n,m,len,sign;
    word2 *x, *y;

    x = AriScratch;
    n = bigretr(argStkPtr-1,x,&sign);
    if (n == aERROR)
        goto errexit;
    m = bigref(argStkPtr,&y,&sign);
    if (m == aERROR)
        goto errexit;
    if (m > n)
        return zero;
    else if(n >= aribufSize) {
        error(gf2Xdivsym,err_ovfl,voidsym);
        return(brkerr());
    }
    else if(!m) {
        error(gf2Xdivsym,err_div,voidsym);
        return brkerr();
    }
    len = gf2poldiv(x,n,y,m,AriBuf);
    return mkint(0,AriBuf,len);

  errexit:
    error(gf2Xdivsym,err_intt,voidsym);
    return brkerr();
}
/*------------------------------------------------------------------*/
PRIVATE truc Fgf2Xmod()
{
    int n,m,len,sign;
    word2 *x, *y;

    x = AriBuf;
    n = bigretr(argStkPtr-1,x,&sign);
    if (n == aERROR)
        goto errexit;
    m = bigref(argStkPtr,&y,&sign);
    if (m == aERROR)
        goto errexit;
    if(n >= aribufSize) {
        error(gf2Xmodsym,err_ovfl,voidsym);
        return(brkerr());
    }
    else if(!m) {
        error(gf2Xmodsym,err_div,voidsym);
        return brkerr();
    }
    len = gf2polmod(x,n,y,m);
    return mkint(0,AriBuf,len);

  errexit:
    error(gf2Xmodsym,err_intt,voidsym);
    return brkerr();
}
/*------------------------------------------------------------------*/
PRIVATE truc Fgf2Xgcd()
{
    int n,m,len,sign;
    word2 *x, *y;

    x = AriBuf;
    y = AriScratch;
    n = bigretr(argStkPtr-1,x,&sign);
    if (n == aERROR)
        goto errexit;
    m = bigretr(argStkPtr,y,&sign);
    if (m == aERROR)
        goto errexit;
    len = gf2polgcd(x,n,y,m);
    return mkint(0,AriBuf,len);

  errexit:
    error(gf2Xgcdsym,err_intt,voidsym);
    return brkerr();
}
/*------------------------------------------------------------------*/
PRIVATE truc Fgf2Xmodpow()
{
    word2 *x, *y, *f;
    int n,m,flen,len,sign;
    int flg;
    truc symb;

    n = bigref(argStkPtr-2,&x,&sign);
    if (n == aERROR) {
        symb = argStkPtr[-2];
        goto errexit;
    }
    flg = *FLAGPTR(argStkPtr-1);
    if (flg != fFIXNUM && flg != fBIGNUM) {
        error(gf2Xmpowsym,err_int,argStkPtr[-1]);
        return brkerr();
    }
    flen = bigref(argStkPtr,&f,&sign);
    if (flen == aERROR) {
        symb = argStkPtr[0];
        goto errexit;
    }
    else if (flen >= aribufSize/2 - 1) {
        error(gf2Xmpowsym,err_ovfl,argStkPtr[0]);
        return brkerr();
    }
    m = bigref(argStkPtr-1,&y,&sign);
    if (m == aERROR) {
        symb = argStkPtr[-1];
        goto errexit;
    }
    else if (sign) {
/******************************/
/* TODO: negative exponent */
        error(gf2Xmpowsym,err_p0int,argStkPtr[-1]);
        return brkerr();
    }
    len = gf2polmodpow(x,n,y,m,f,flen,AriBuf,AriScratch);

    return mkint(0,AriBuf,len);

  errexit:
    error(gf2Xmpowsym,err_intt,symb);
    return brkerr();
}
/*------------------------------------------------------------------*/
/*
** P := (x,n) and Q := (y,m) are considered as polynomials over GF(2)
** Calculates P mod Q; works destructively on x; returns new length
*/
PRIVATE int gf2polmod(x,n,y,m)
word2 *x, *y;
int n,m;
{
    int N, M, k, s;

    if(m == 0)
        return n;

    N = bit_length(x,n) - 1;
    M = bit_length(y,m) - 1;
    if(M > N)
        return n;
    for(k=N; k>=M; --k) {
        if(testbit(x,k)) {
            s = k-M;
            n = bitxorshift(x,n,y,m,s);
        }
    }
    return n;
}
/*------------------------------------------------------------------*/
/*
** P := (x,n) and Q := (y,m) are considered as polynomials over GF(2)
** Calculates P div Q; works destructively on x;
** Result returned in z; return value=zlen
*/
PRIVATE int gf2poldiv(x,n,y,m,z)
word2 *x, *y, *z;
int n,m;
{
    int N, M, k, s, zlen;

    if(m == 0)
        return n;

    N = bit_length(x,n) - 1;
    M = bit_length(y,m) - 1;
    if(M > N)
        return 0;
    zlen = (N - M)/16 + 1;
    setarr(z,zlen,0);
    for(k=N; k>=M; --k) {
        if(testbit(x,k)) {
            s = k-M;
            n = bitxorshift(x,n,y,m,s);
            setbit(z,s);
        }
    }
    return zlen;
}
/*------------------------------------------------------------------*/
/*
** P := (x,n) and Q := (y,m) are considered as polynomials over GF(2)
** Calculates P div Q; works destructively on x;
** Quotient returned in z; return value=zlen
** x becomes rest, ist len is returned in *rlentpr
*/
PRIVATE int gf2poldivide(x,n,y,m,z,rlenptr)
word2 *x, *y, *z;
int n,m;
int *rlenptr;
{
    int N, M, k, s, zlen;

    if(m == 0) {    /* division by zero */
        *rlenptr = n;
        return 0;
    }
    N = bit_length(x,n) - 1;
    M = bit_length(y,m) - 1;
    if(M > N) {
        *rlenptr = n;
        return 0;
    }
    zlen = (N - M)/16 + 1;
    setarr(z,zlen,0);
    for(k=N; k>=M; --k) {
        if(testbit(x,k)) {
            s = k-M;
            n = bitxorshift(x,n,y,m,s);
            setbit(z,s);
        }
    }
    *rlenptr = n;
    return zlen;
}
/*------------------------------------------------------------------*/
PRIVATE int gf2ntrace(x,n)
word2 *x;
int n;
{
    int deg = gf2nField.deg;
    unsigned ftail = gf2nField.ftail;
    int k, m, t;

    m = (deg/16) + 1;
    for(k=n; k<m; k++)
        x[k] = 0;
    t = (x[0] & 1);
    for(k=1; k<deg; k++) {
        n = shiftleft1(x,n);
        if(n > m)
            n = m;
        if(testbit(x,deg))
            x[0] ^= ftail;
        if(testbit(x,k))
            t++;
    }
    return (t & 1);
}
/*------------------------------------------------------------------*/
/*
** Shift (x,n) to the left by 1 bit
** Works destructively on x
*/
PRIVATE int shiftleft1(x,n)
word2 *x;
int n;
{
    int k, ovfl;
    unsigned maskhi = 0x8000, u = 1;

    if(n == 0)
        return n;
    ovfl = (x[n-1] & maskhi);
    for(k=n-1; k>=1; k--) {
        x[k] <<= 1;
        if(x[k-1] & maskhi)
            x[k] |= u;
    }
    x[0] <<= 1;
    if(ovfl) {
        x[n] = u;
        n++;
    }
    return n;
}
/*------------------------------------------------------------------*/
/*
** (y,m) is shifted by s >= 0 and xored with (x,n)
** If bitlength of (x,n) < bitlength of (y,m) plus s,
** higher entries of x must be 0.
*/
PRIVATE int bitxorshift(x,n,y,m,s)
word2 *x, *y;
int n,m,s;
{
    int s0, s1, t1, k, k1;
    unsigned u;

    if(!m)
        return n;

    s0 = (s >> 4);
    s1 = (s & 0xF);

    if(s1 == 0) {
        for(k=0, k1=s0-1; k<m; k++) {
            x[++k1] ^= y[k];
        }
    }
    else {
        t1 = 16 - s1;
        x[s0] ^= (y[0] << s1);
        for(k=1, k1=s0; k<m; k++) {
            x[++k1] ^= ((y[k] << s1) | (y[k-1] >> t1));
        }
        u = (y[m-1] >> t1);
        if(u) {
            x[++k1] ^= u;
        }
    }
    if(k1 >= n)
        n = k1+1;
    while((n > 0) && (x[n-1] == 0))
        n--;
    return n;
}
/*------------------------------------------------------------------*/
/*
** Reduce (x,n) modulo the field polynomial given in gf2nField
** Works destructively on (x,n)
*/
PRIVATE int gf2nmod(x,n)
word2 *x;
int n;
{
    int N, m, s, s0, s1;
    int deg = gf2nField.deg;
    unsigned ftail = gf2nField.ftail;
    unsigned mask = 0xFFFF;
    unsigned t1, t2;

    N = bit_length(x,n) - 1;
    if(N < deg)
        return n;

    m = (deg >> 4);
    mask >>= (16 - (deg & 0xF));

    for(s = N-deg; s >= 0; s--) {
        if(testbit(x,deg+s)) {
            s0 = (s >> 4);
            s1 = (s & 0xF);
            t1 = (ftail << s1);
            x[s0] ^= t1;
            if(s1 && (t2 = (ftail >> (16-s1))))
                x[s0+1] ^= t2;
        }
    }
    x[m] &= mask;
    while(m >= 0 && (x[m] == 0))
        m--;
    return m+1;
}
/*------------------------------------------------------------------*/
/*
** Multiplies gf2pols (x,n) and (y,m);
** does not alter (x,n) or (y,m)
** Result returned in z
*/
PRIVATE int gf2polmult(x,n,y,m,z)
word2 *x, *y, *z;
int n,m;
{
    int k, M, n1;

    M = bit_length(y,m) - 1;
    if(M < 0)
        return 0;
    cpyarr(x,n,z);
    n1 = shiftarr(z,n,M);
    for(k=M-1; k>=0; k--) {
        if(testbit(y,k)) {
            n1 = bitxorshift(z,n1,x,n,k);
        }
    }
    return n1;
}
/*------------------------------------------------------------------*/
/*
** Squares the gf2pol (x,n)
** Result returned in z
*/
PRIVATE int gf2polsquare(x,n,z)
word2 *x, *z;
int n;
{
    int k, N;
    unsigned u;

    if(n == 0)
        return 0;
    N = 0;
    for(k=0; k<n-1; k++) {
        u = x[k];
        z[N] = spreadbyte[u & 0x00FF];
        N++;
        z[N] = spreadbyte[(u >> 8) & 0x00FF];
        N++;
    }
    u = x[n-1];
    z[N] = spreadbyte[u & 0x00FF];
    N++;
    u = (u >> 8) & 0x00FF;
    if(u) {
        z[N] = spreadbyte[u];
        N++;
    }
    return N;
}
/*-------------------------------------------------------------------*/
/*
** Calculates inverse of (x,n).
** Result in z; if (x,n) is not invertible, 0 is returned
** uu is an auxiliary array needed for intermediate calculations
*/
PRIVATE int gf2ninverse(x,n,z,uu)
word2 *x, *z, *uu;
int n;
{
    int deg, m, zlen;
    word2 *y;

    y = uu;
    deg = gf2nField.deg;
    m = (deg+1)/16 + 1;
    setarr(y,m,0);
    y[0] = gf2nField.ftail;
    setbit(y,deg);

    uu = y + m + 1;
    n = gf2polgcdx(x,n,y,m,z,&zlen,uu);
    if(x[0] != 1 || n != 1) {
        return 0;
    }
    return zlen;
}
/*------------------------------------------------------------------*/
/*
** gf2nint (x,n) is raised to power (y,n)
** Result in z; hilf is an auxiliary array
*/
PRIVATE int gf2npower(x,n,y,m,z,hilf)
word2 *x,*y,*z,*hilf;
int n, m;
{
    int N, k, exlen;

    if(m == 0) {
        z[0] = 1;
        return 1;
    }
    else if(n == 0)
        return 0;
    exlen = bit_length(y,m);
    cpyarr(x,n,z);
    N = n;
    for(k=exlen-2; k>=0; k--) {
        cpyarr(z,N,hilf);
        N = gf2polsquare(hilf,N,z);
        N = gf2nmod(z,N);
        if(testbit(y,k)) {
            cpyarr(z,N,hilf);
            N = gf2polmult(hilf,N,x,n,z);
            N = gf2nmod(z,N);
        }
    }
    return N;
}
/*------------------------------------------------------------------*/
/*
** gf2pol (x,n) is raised to power (y,n) modulo (f,flen)
** Result in z; hilf is an auxiliary array
** (x,n), (y,m) and (f,flen) are not altered
*/
PRIVATE int gf2polmodpow(x,n,y,m,f,flen,z,hilf)
word2 *x,*y,*z,*f,*hilf;
int n, m, flen;
{
    int N, k, exlen;

    if(m == 0) {
        z[0] = 1;
        return 1;
    }
    else if(n == 0)
        return 0;
    exlen = bit_length(y,m);
    cpyarr(x,n,z);
    N = n;
    for(k=exlen-2; k>=0; k--) {
        cpyarr(z,N,hilf);
        N = gf2polsquare(hilf,N,z);
        N = gf2polmod(z,N,f,flen);
        if(testbit(y,k)) {
            cpyarr(z,N,hilf);
            N = gf2polmult(hilf,N,x,n,z);
            N = gf2polmod(z,N,f,flen);
        }
    }
    return N;
}
/*------------------------------------------------------------------*/
/*
** Calculates greatest common divisor of gf2pols (x,n) and (y,m);
** Works destructively on x and y
** Result is returned in x
*/
PRIVATE int gf2polgcd(x,n,y,m)
word2 *x, *y;
int n,m;
{
    while(m > 0) {
        n = gf2polmod(x,n,y,m);
        if(n == 0) {
            cpyarr(y,m,x);
            n = m;
            break;
        }
        m = gf2polmod(y,m,x,n);
    }
    return n;
}
/*-----------------------------------------------------------------*/
/*
** Calculates the gcd d of (x,n) and (y,m) (considered as polynomials
** over GF(2)) and calculates a coefficient lambda such that
** d = lambda*(x,n) mod (y,m).
** Works destructively on x and y.
** The gcd is stored in x, its length is the return value;
** lambda = (z, *zlenptr)
** uu is an auxiliary array needed for intermediate calculations
*/
PRIVATE int gf2polgcdx(x,n,y,m,z,zlenptr,uu)
word2 *x, *y, *z, *uu;
int n,m;
int *zlenptr;
{
    int s, N, M, zlen, ulen, nn, m0;
    word2 *y0;

    nn = (n >= m ? n : m);
    setarr(z,nn,0);
    setarr(uu,nn,0);
    z[0] = 1;
    zlen = 1;
    ulen = 0;
    m0 = m;
    y0 = uu + nn + 1;
    cpyarr(y,m0,y0);

    N = bit_length(x,n);
    M = bit_length(y,m);

    while(M > 0) {
    /* loop invariants:
        (x,n) =  z*(x0,n0) mod (y0,m0);
        (y,m) = uu*(x0,n0) mod (y0,m0);
       where (x0,n0) and (y0,m0) are the initial
       values of (x,n) and (y,m)
    */
        if(N >= M) {
            s = N - M;
            n = bitxorshift(x,n,y,m,s);
            N = bit_length(x,n);
            zlen = bitxorshift(z,zlen,uu,ulen,s);
            if(zlen > m0)
                zlen = gf2polmod(z,zlen,y0,m0);
        }
        else {
            s = M - N;
            m = bitxorshift(y,m,x,n,s);
            M = bit_length(y,m);
            ulen = bitxorshift(uu,ulen,z,zlen,s);
            if(ulen > m0)
                ulen = gf2polmod(uu,ulen,y0,m0);
        }
        if(N == 0) {
            cpyarr(y,m,x);
            n = m;
            cpyarr(uu,ulen,z);
            zlen = ulen;
            break;
        }
    }
    if(bit_length(z,zlen) >= bit_length(y0,m0))
        zlen = gf2polmod(z,zlen,y0,m0);
    *zlenptr = zlen;
    return n;
}
/*-----------------------------------------------------------------*/
PRIVATE truc Fgf2Xprimtest()
{
    int n, sign, res;
    word2 *x;

    n = bigref(argStkPtr,&x,&sign);
    if (n == aERROR) {
        error(gf2Xprimsym,err_intt,argStkPtr[0]);
        return brkerr();
    }
    res = gf2polirred1(x,n,AriBuf,AriScratch);
    return (res ? true : false);
}
/*-----------------------------------------------------------------*/
/*
** Tests whether the gf2 polynomial given by (x,n) is irreducible.
** yy and zz are auxiliary arrays needed for intermediate calculations
*/
PRIVATE int gf2polirred1(x,n,yy,zz)
word2 *x, *yy, *zz;
int n;
{
    int m, m1, N, N0, k, mode;
    word2 xi;
    word2 *x2k;

    if (n == 0)
        return 0;
    if ((x[0] & 1) == 0)  /* polynomial divisible by X */
        return 0;

    N = bit_length(x,n) - 1;
    N0 = 5*intsqrt(N);  /* somewhat arbitrary */
    if (N0 < N/3) {
        mode = 1;
    }
    else {
        mode = 0;
        N0 = N/2;
    }
    x2k = zz + n + 1;
    xi = 2;
    m = 1;
    x2k[0] = xi;
    for(k=1; k<=N0; k++) {
        m = gf2polsquare(x2k,m,yy);
        m = gf2polmod(yy,m,x,n);
        if((m == 1 && yy[0] == xi) || m == 0)
            return 0;
        cpyarr(yy,m,x2k);
        yy[0] ^= xi;
        cpyarr(x,n,zz);
        m1 = gf2polgcd(yy,m,zz,n);
        if(m1 != 1 || yy[0] != 1) {
            return 0;
        }
    }
    if (mode == 0)
        return 1;
    for(k=N0+1; k<N; k++) {
        m = gf2polsquare(x2k,m,yy);
        m = gf2polmod(yy,m,x,n);
        if((yy[0] == xi && m == 1) || m == 0)
            return 0;
        cpyarr(yy,m,x2k);
    }
    m = gf2polsquare(x2k,m,yy);
    m = gf2polmod(yy,m,x,n);
    if (yy[0] == xi && m == 1)
        return 1;
    else
        return 0;
}
/*-----------------------------------------------------------------*/
/*
** Tests whether the gf2 polynomial given by (x,n) is irreducible.
** yy and zz are auxiliary arrays needed for intermediate calculations
*/
PRIVATE int gf2polirred(x,n,yy,zz)
word2 *x, *yy, *zz;
int n;
{
    int m, m1, N, k;
    word2 xi;
    word2 *x2k;

    if(n == 0)
        return 0;
    N = bit_length(x,n) - 1;
    if(N <= 1)
        return N;
    x2k = zz + n + 1;
    xi = 2;
    m = 1;
    yy[0] = xi;
    N = N/2;
    for(k=1; k<=N; k++) {
        m = gf2polmult(yy,m,yy,m,x2k);
        cpyarr(x,n,zz);
        m = gf2polmod(x2k,m,zz,n);
        if(m == 1 && x2k[0] == xi)
            return 0;
        cpyarr(x2k,m,yy);
        if (m == 0) {
            x2k[0] = xi;
            m1 = 1;
        }
        else {
            x2k[0] ^= xi;
            m1 = m;
        }
        m1 = gf2polgcd(x2k,m1,zz,n);
        if(m1 != 1 || x2k[0] != 1) {
            return 0;
        }
    }
    return 1;
}
/*-----------------------------------------------------------------*/
PRIVATE unsigned gf2polfindirr(n)
int n;
{
    unsigned u;
    int m;
    word2 *x, *yy, *zz;

    if(n < 2)
        return 0;
    m = (n+1)/16 + 1;
    x = AriBuf;
    yy = AriBuf + m + 1;
    zz = AriScratch;

    for(u=3; u<0xFFF0; u+=2) {
        if(bitcount(u) & 1)
            continue;
        setarr(x,m,0);
        x[0] = u;
        setbit(x,n);
        if(gf2polirred(x,m,yy,zz))
            return u;
    }
    return 0;
}
/*******************************************************************/
