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

Annotation of OpenXM_contrib2/asir2000/builtin/fctr.c, Revision 1.17

1.2       noro        1: /*
                      2:  * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
                      3:  * All rights reserved.
                      4:  *
                      5:  * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
                      6:  * non-exclusive and royalty-free license to use, copy, modify and
                      7:  * redistribute, solely for non-commercial and non-profit purposes, the
                      8:  * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
                      9:  * conditions of this Agreement. For the avoidance of doubt, you acquire
                     10:  * only a limited right to use the SOFTWARE hereunder, and FLL or any
                     11:  * third party developer retains all rights, including but not limited to
                     12:  * copyrights, in and to the SOFTWARE.
                     13:  *
                     14:  * (1) FLL does not grant you a license in any way for commercial
                     15:  * purposes. You may use the SOFTWARE only for non-commercial and
                     16:  * non-profit purposes only, such as academic, research and internal
                     17:  * business use.
                     18:  * (2) The SOFTWARE is protected by the Copyright Law of Japan and
                     19:  * international copyright treaties. If you make copies of the SOFTWARE,
                     20:  * with or without modification, as permitted hereunder, you shall affix
                     21:  * to all such copies of the SOFTWARE the above copyright notice.
                     22:  * (3) An explicit reference to this SOFTWARE and its copyright owner
                     23:  * shall be made on your publication or presentation in any form of the
                     24:  * results obtained by use of the SOFTWARE.
                     25:  * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
1.3       noro       26:  * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.2       noro       27:  * for such modification or the source code of the modified part of the
                     28:  * SOFTWARE.
                     29:  *
                     30:  * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
                     31:  * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
                     32:  * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
                     33:  * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
                     34:  * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
                     35:  * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
                     36:  * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
                     37:  * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
                     38:  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
                     39:  * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
                     40:  * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
                     41:  * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
                     42:  * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
                     43:  * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
                     44:  * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
                     45:  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
                     46:  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
                     47:  *
1.17    ! noro       48:  * $OpenXM: OpenXM_contrib2/asir2000/builtin/fctr.c,v 1.16 2002/10/31 03:59:50 noro Exp $
1.2       noro       49: */
1.1       noro       50: #include "ca.h"
                     51: #include "parse.h"
                     52:
                     53: void Pfctr(), Pgcd(), Pgcdz(), Plcm(), Psqfr(), Pufctrhint();
1.17    ! noro       54: void Pptozp(), Pcont(), Psfcont();
1.1       noro       55: void Pafctr(), Pagcd();
                     56: void Pmodsqfr(),Pmodfctr(),Pddd(),Pnewddd(),Pddd_tab();
1.15      noro       57: void Psfsqfr(),Psffctr(),Psfbfctr(),Psfufctr(),Psfmintdeg(),Psfgcd();
1.1       noro       58: void Pirred_check(), Pnfctr_mod();
1.16      noro       59: void Pbivariate_hensel_special();
1.1       noro       60:
1.11      noro       61: void sfmintdeg(VL vl,P fx,int dy,int c,P *fr);
                     62:
1.1       noro       63: struct ftab fctr_tab[] = {
1.16      noro       64:        {"bivariate_hensel_special",Pbivariate_hensel_special,6},
1.5       noro       65:        {"fctr",Pfctr,-2},
1.1       noro       66:        {"gcd",Pgcd,-3},
                     67:        {"gcdz",Pgcdz,2},
                     68:        {"lcm",Plcm,2},
                     69:        {"sqfr",Psqfr,1},
                     70:        {"ufctrhint",Pufctrhint,2},
                     71:        {"ptozp",Pptozp,1},
                     72:        {"cont",Pcont,-2},
1.17    ! noro       73:        {"sfcont",Psfcont,-2},
1.1       noro       74:        {"afctr",Pafctr,2},
                     75:        {"agcd",Pagcd,3},
                     76:        {"modsqfr",Pmodsqfr,2},
                     77:        {"modfctr",Pmodfctr,2},
1.10      noro       78:        {"sfsqfr",Psfsqfr,1},
1.15      noro       79:        {"sffctr",Psffctr,1},
1.10      noro       80:        {"sfufctr",Psfufctr,1},
                     81:        {"sfbfctr",Psfbfctr,-4},
1.11      noro       82:        {"sfmintdeg",Psfmintdeg,5},
1.13      noro       83:        {"sfgcd",Psfgcd,2},
1.1       noro       84: #if 0
                     85:        {"ddd",Pddd,2},
                     86:        {"newddd",Pnewddd,2},
                     87: #endif
                     88:        {"ddd_tab",Pddd_tab,2},
                     89:        {"irred_check",Pirred_check,2},
                     90:        {"nfctr_mod",Pnfctr_mod,2},
                     91:        {0,0,0},
                     92: };
1.16      noro       93:
                     94: /* bivariate_hensel_special(f(x,y):monic in x,g0(x),h0(y),x,y,d) */
                     95:
                     96: void Pbivariate_hensel_special(arg,rp)
                     97: NODE arg;
                     98: LIST *rp;
                     99: {
                    100:        DCP dc;
                    101:        struct oVN vn[2];
                    102:        P f,g0,h0,ak,bk,gk,hk;
                    103:        V vx,vy;
                    104:        VL nvl;
                    105:        Q qk,cbd,bb;
                    106:        int d;
                    107:        NODE n;
                    108:
                    109:        f = (P)ARG0(arg);
                    110:        g0 = (P)ARG1(arg);
                    111:        h0 = (P)ARG2(arg);
                    112:        vx = VR((P)ARG3(arg));
                    113:        vy = VR((P)ARG4(arg));
                    114:        d = QTOS((Q)ARG5(arg));
                    115:        NEWVL(nvl); nvl->v = vx;
                    116:        NEWVL(NEXT(nvl)); NEXT(nvl)->v = vy;
                    117:        NEXT(NEXT(nvl)) = 0;
                    118:        vn[0].v = vy; vn[0].n = 0;
                    119:        vn[1].v = 0; vn[1].n = 0;
                    120:        cbound(nvl,f,&cbd);
                    121:        addq(cbd,cbd,&bb);
                    122:        henzq1(g0,h0,bb,&bk,&ak,&qk);
                    123:        henmv(nvl,vn,f,g0,h0,ak,bk,(P)ONE,(P)ONE,(P)ONE,(P)ONE,qk,d,&gk,&hk);
                    124:        n = mknode(2,gk,hk);
                    125:        MKLIST(*rp,n);
                    126: }
1.1       noro      127:
                    128: void Pfctr(arg,rp)
                    129: NODE arg;
                    130: LIST *rp;
                    131: {
                    132:        DCP dc;
                    133:
                    134:        asir_assert(ARG0(arg),O_P,"fctr");
1.5       noro      135:        if ( argc(arg) == 1 )
                    136:                fctrp(CO,(P)ARG0(arg),&dc);
                    137:        else {
                    138:                asir_assert(ARG1(arg),O_P,"fctr");
                    139:                fctr_wrt_v_p(CO,(P)ARG0(arg),VR((P)ARG1(arg)),&dc);
                    140:        }
1.1       noro      141:        dcptolist(dc,rp);
                    142: }
                    143:
                    144: void Pgcd(arg,rp)
                    145: NODE arg;
                    146: P *rp;
                    147: {
                    148:        P p1,p2,g1,g2,g;
                    149:        Num m;
                    150:        int mod;
                    151:
                    152:        p1 = (P)ARG0(arg); p2 = (P)ARG1(arg);
                    153:        asir_assert(p1,O_P,"gcd");
                    154:        asir_assert(p2,O_P,"gcd");
                    155:        if ( !p1 )
                    156:                *rp = p2;
                    157:        else if ( !p2 )
                    158:                *rp = p1;
                    159:        else if ( !qpcheck((Obj)p1) || !qpcheck((Obj)p2) )
1.4       noro      160:                gcdprsp(CO,p1,p2,rp);
1.1       noro      161:        else if ( argc(arg) == 2 )
                    162:                ezgcdp(CO,p1,p2,rp);
                    163:        else {
                    164:                m = (Num)ARG2(arg);
                    165:                asir_assert(m,O_P,"gcd");
                    166:                mod = QTOS((Q)m);
                    167:                ptomp(mod,p1,&g1); ptomp(mod,p2,&g2);
                    168:                gcdprsmp(CO,mod,g1,g2,&g);
                    169:                mptop(g,rp);
                    170:        }
                    171: }
                    172:
                    173: void Pgcdz(arg,rp)
                    174: NODE arg;
                    175: P *rp;
                    176: {
                    177:        P p1,p2,t;
                    178:        Q c1,c2;
                    179:        N n;
                    180:
                    181:        p1 = (P)ARG0(arg); p2 = (P)ARG1(arg);
                    182:        asir_assert(p1,O_P,"gcdz");
                    183:        asir_assert(p2,O_P,"gcdz");
                    184:        if ( !p1 )
                    185:                *rp = p2;
                    186:        else if ( !p2 )
                    187:                *rp = p1;
                    188:        else if ( !qpcheck((Obj)p1) || !qpcheck((Obj)p2) )
                    189:                error("gcdz : invalid argument");
                    190:        else if ( NUM(p1) || NUM(p2) ) {
                    191:                if ( NUM(p1) )
                    192:                        c1 = (Q)p1;
                    193:                else
                    194:                        ptozp(p1,1,&c1,&t);
                    195:                if ( NUM(p2) )
                    196:                        c2 = (Q)p2;
                    197:                else
                    198:                        ptozp(p2,1,&c2,&t);
                    199:                gcdn(NM(c1),NM(c2),&n); NTOQ(n,1,c1); *rp = (P)c1;
                    200:        } else {
                    201: #if 0
                    202:                w[0] = p1; w[1] = p2; nezgcdnpz(CO,w,2,rp);
                    203: #endif
                    204:                ezgcdpz(CO,p1,p2,rp);
                    205:        }
                    206: }
                    207:
                    208: void Plcm(arg,rp)
                    209: NODE arg;
                    210: P *rp;
                    211: {
                    212:        P t1,t2,p1,p2,g,q;
                    213:        Q c;
                    214:
                    215:        p1 = (P)ARG0(arg); p2 = (P)ARG1(arg);
                    216:        asir_assert(p1,O_P,"lcm");
                    217:        asir_assert(p2,O_P,"lcm");
                    218:        if ( !p1 || !p2 )
                    219:                *rp = 0;
                    220:        else if ( !qpcheck((Obj)p1) || !qpcheck((Obj)p2) )
                    221:                error("lcm : invalid argument");
                    222:        else {
                    223:                ptozp(p1,1,&c,&t1); ptozp(p2,1,&c,&t2);
                    224:                ezgcdp(CO,t1,t2,&g); divsp(CO,t1,g,&q); mulp(CO,q,t2,rp);
                    225:        }
                    226: }
                    227:
                    228: void Psqfr(arg,rp)
                    229: NODE arg;
                    230: LIST *rp;
                    231: {
                    232:        DCP dc;
                    233:
                    234:        asir_assert(ARG0(arg),O_P,"sqfr");
                    235:        sqfrp(CO,(P)ARG0(arg),&dc);
                    236:        dcptolist(dc,rp);
                    237: }
                    238:
                    239: void Pufctrhint(arg,rp)
                    240: NODE arg;
                    241: LIST *rp;
                    242: {
                    243:        DCP dc;
                    244:
                    245:        asir_assert(ARG0(arg),O_P,"ufctrhint");
                    246:        asir_assert(ARG1(arg),O_N,"ufctrhint");
                    247:        ufctr((P)ARG0(arg),QTOS((Q)ARG1(arg)),&dc);
                    248:        dcptolist(dc,rp);
                    249: }
                    250:
                    251: #if 0
                    252: Pmgcd(arg,rp)
                    253: NODE arg;
                    254: Obj *rp;
                    255: {
                    256:        NODE node,tn;
                    257:        int i,m;
                    258:        P *l;
                    259:
                    260:        node = BDY((LIST)ARG0(arg));
                    261:        for ( i = 0, tn = node; tn; tn = NEXT(tn), i++ );
                    262:        m = i; l = (P *)ALLOCA(m*sizeof(P));
                    263:        for ( i = 0, tn = node; i < m; tn = NEXT(tn), i++ )
                    264:                l[i] = (P)BDY(tn);
                    265:        nezgcdnpz(CO,l,m,rp);
                    266: }
                    267: #endif
                    268:
                    269: void Pcont(arg,rp)
                    270: NODE arg;
                    271: P *rp;
                    272: {
                    273:        DCP dc;
                    274:        int m;
                    275:        P p,p1;
                    276:        P *l;
                    277:        V v;
                    278:
                    279:        asir_assert(ARG0(arg),O_P,"cont");
                    280:        p = (P)ARG0(arg);
                    281:        if ( NUM(p) )
                    282:                *rp = p;
                    283:        else {
                    284:                if ( argc(arg) == 2 ) {
                    285:                        v = VR((P)ARG1(arg));
                    286:                        change_mvar(CO,p,v,&p1);
                    287:                        if ( VR(p1) != v ) {
                    288:                                *rp = p1; return;
                    289:                        } else
                    290:                                p = p1;
                    291:                }
                    292:                for ( m = 0, dc = DC(p); dc; dc = NEXT(dc), m++ );
                    293:                l = (P *)ALLOCA(m*sizeof(P));
                    294:                for ( m = 0, dc = DC(p); dc; dc = NEXT(dc), m++ )
                    295:                        l[m] = COEF(dc);
                    296:                nezgcdnpz(CO,l,m,rp);
1.17    ! noro      297:        }
        !           298: }
        !           299:
        !           300: void Psfcont(arg,rp)
        !           301: NODE arg;
        !           302: P *rp;
        !           303: {
        !           304:        DCP dc;
        !           305:        int m;
        !           306:        P p,p1;
        !           307:        P *l;
        !           308:        V v;
        !           309:
        !           310:        asir_assert(ARG0(arg),O_P,"sfcont");
        !           311:        p = (P)ARG0(arg);
        !           312:        if ( NUM(p) )
        !           313:                *rp = p;
        !           314:        else {
        !           315:                if ( argc(arg) == 2 ) {
        !           316:                        v = VR((P)ARG1(arg));
        !           317:                        change_mvar(CO,p,v,&p1);
        !           318:                        if ( VR(p1) != v ) {
        !           319:                                *rp = p1; return;
        !           320:                        } else
        !           321:                                p = p1;
        !           322:                }
        !           323:                for ( m = 0, dc = DC(p); dc; dc = NEXT(dc), m++ );
        !           324:                l = (P *)ALLOCA(m*sizeof(P));
        !           325:                for ( m = 0, dc = DC(p); dc; dc = NEXT(dc), m++ )
        !           326:                        l[m] = COEF(dc);
        !           327:                gcdsf(CO,l,m,rp);
1.1       noro      328:        }
                    329: }
                    330:
                    331: void Pptozp(arg,rp)
                    332: NODE arg;
                    333: P *rp;
                    334: {
                    335:        Q t;
                    336:
                    337:        asir_assert(ARG0(arg),O_P,"ptozp");
                    338:        ptozp((P)ARG0(arg),1,&t,rp);
                    339: }
                    340:
                    341: void Pafctr(arg,rp)
                    342: NODE arg;
                    343: LIST *rp;
                    344: {
                    345:        DCP dc;
                    346:
                    347:        asir_assert(ARG0(arg),O_P,"afctr");
                    348:        asir_assert(ARG1(arg),O_P,"afctr");
                    349:        afctr(CO,(P)ARG0(arg),(P)ARG1(arg),&dc);
                    350:        dcptolist(dc,rp);
                    351: }
                    352:
                    353: void Pagcd(arg,rp)
                    354: NODE arg;
                    355: P *rp;
                    356: {
                    357:        asir_assert(ARG0(arg),O_P,"agcd");
                    358:        asir_assert(ARG1(arg),O_P,"agcd");
                    359:        asir_assert(ARG2(arg),O_P,"agcd");
                    360:        gcda(CO,(P)ARG0(arg),(P)ARG1(arg),(P)ARG2(arg),rp);
                    361: }
                    362:
                    363: #if 1
                    364: #define Mulum mulum
                    365: #define Divum divum
                    366: #define Mulsum mulsum
                    367: #define Gcdum gcdum
                    368: #endif
                    369:
                    370: void Mulum(), Mulsum(), Gcdum();
                    371: int Divum();
                    372:
                    373: #define FCTR 0 /* berlekamp */
                    374: #define SQFR 1
                    375: #define DDD 2  /* Cantor-Zassenhauss */
                    376: #define NEWDDD 3  /* berlekamp + root-finding by Cantor-Zassenhauss */
                    377:
                    378: UM *resberle();
                    379:
                    380: void Pmodfctr(arg,rp)
                    381: NODE arg;
                    382: LIST *rp;
                    383: {
                    384:        DCP dc;
                    385:        int mod;
                    386:
                    387:        mod = QTOS((Q)ARG1(arg));
                    388:        if ( mod < 0 )
                    389:                error("modfctr : invalid modulus");
                    390:        modfctrp(ARG0(arg),mod,NEWDDD,&dc);
1.6       noro      391:        if ( !dc ) {
                    392:                NEWDC(dc); COEF(dc) = 0; DEG(dc) = ONE; NEXT(dc) = 0;
                    393:        }
                    394:        dcptolist(dc,rp);
1.13      noro      395: }
                    396:
                    397: void Psfgcd(arg,rp)
                    398: NODE arg;
                    399: LIST *rp;
                    400: {
                    401:        P ps[2];
                    402:
                    403:        ps[0] = (P)ARG0(arg);
                    404:        ps[1] = (P)ARG1(arg);
                    405:        gcdsf(CO,ps,2,rp);
1.6       noro      406: }
                    407:
1.15      noro      408: void Psffctr(arg,rp)
                    409: NODE arg;
                    410: LIST *rp;
                    411: {
                    412:        DCP dc;
                    413:
                    414:        mfctrsf(CO,ARG0(arg),&dc);
                    415:        dcptolist(dc,rp);
                    416: }
                    417:
1.10      noro      418: void Psfsqfr(arg,rp)
                    419: NODE arg;
                    420: LIST *rp;
                    421: {
                    422:        DCP dc;
                    423:
1.14      noro      424:        sqfrsf(CO,ARG0(arg),&dc);
1.10      noro      425:        dcptolist(dc,rp);
                    426: }
                    427:
                    428: void Psfufctr(arg,rp)
1.6       noro      429: NODE arg;
                    430: LIST *rp;
                    431: {
                    432:        DCP dc;
                    433:
1.15      noro      434:        ufctrsf(ARG0(arg),&dc);
1.1       noro      435:        dcptolist(dc,rp);
1.7       noro      436: }
                    437:
                    438: void Psfbfctr(arg,rp)
                    439: NODE arg;
                    440: LIST *rp;
                    441: {
                    442:        V x,y;
1.8       noro      443:        DCP dc,dct;
                    444:        P t;
                    445:        struct oVL vl1,vl2;
                    446:        VL vl;
1.10      noro      447:        int degbound;
1.7       noro      448:
                    449:        x = VR((P)ARG1(arg));
                    450:        y = VR((P)ARG2(arg));
1.8       noro      451:        vl1.v = x; vl1.next = &vl2;
                    452:        vl2.v = y; vl2.next = 0;
                    453:        vl = &vl1;
1.10      noro      454:        if ( argc(arg) == 4 )
                    455:                degbound = QTOS((Q)ARG3(arg));
                    456:        else
                    457:                degbound = -1;
1.8       noro      458:
1.10      noro      459:        sfbfctr((P)ARG0(arg),x,y,degbound,&dc);
1.8       noro      460:        for ( dct = dc; dct; dct = NEXT(dct) ) {
                    461:                reorderp(CO,vl,COEF(dct),&t); COEF(dct) = t;
1.7       noro      462:        }
1.8       noro      463:        dcptolist(dc,rp);
1.1       noro      464: }
                    465:
1.11      noro      466: void Psfmintdeg(arg,rp)
                    467: NODE arg;
                    468: P *rp;
                    469: {
                    470:        V x,y;
                    471:        P r;
                    472:        struct oVL vl1,vl2;
                    473:        VL vl;
                    474:        int dy,c;
                    475:
                    476:        x = VR((P)ARG1(arg));
                    477:        y = VR((P)ARG2(arg));
                    478:        vl1.v = x; vl1.next = &vl2;
                    479:        vl2.v = y; vl2.next = 0;
                    480:        vl = &vl1;
                    481:        dy = QTOS((Q)ARG3(arg));
                    482:        c = QTOS((Q)ARG4(arg));
                    483:        sfmintdeg(vl,(P)ARG0(arg),dy,c,&r);
                    484:        reorderp(CO,vl,r,rp);
                    485: }
                    486:
1.1       noro      487: void Pmodsqfr(arg,rp)
                    488: NODE arg;
                    489: LIST *rp;
                    490: {
                    491:        DCP dc;
                    492:
1.9       noro      493:        if ( !ARG0(arg) ) {
1.1       noro      494:                NEWDC(dc); COEF(dc) = 0; DEG(dc) = ONE; NEXT(dc) = 0;
1.9       noro      495:        } else
                    496:                modfctrp(ARG0(arg),QTOS((Q)ARG1(arg)),SQFR,&dc);
1.1       noro      497:        dcptolist(dc,rp);
                    498: }
                    499:
                    500: void Pddd(arg,rp)
                    501: NODE arg;
                    502: LIST *rp;
                    503: {
                    504:        DCP dc;
                    505:
1.9       noro      506:        if ( !ARG0(arg) ) {
1.1       noro      507:                NEWDC(dc); COEF(dc) = 0; DEG(dc) = ONE; NEXT(dc) = 0;
1.9       noro      508:        } else
                    509:                modfctrp(ARG0(arg),QTOS((Q)ARG1(arg)),DDD,&dc);
1.1       noro      510:        dcptolist(dc,rp);
                    511: }
                    512:
                    513: void Pnewddd(arg,rp)
                    514: NODE arg;
                    515: LIST *rp;
                    516: {
1.9       noro      517:        DCP dc=0;
1.1       noro      518:
1.9       noro      519:        if ( !ARG0(arg) ) {
1.1       noro      520:                NEWDC(dc); COEF(dc) = 0; DEG(dc) = ONE; NEXT(dc) = 0;
1.9       noro      521:        } else
                    522:                modfctrp(ARG0(arg),QTOS((Q)ARG1(arg)),NEWDDD,&dc);
1.1       noro      523:        dcptolist(dc,rp);
                    524: }
                    525:
                    526: void Pirred_check(arg,rp)
                    527: NODE arg;
                    528: Q *rp;
                    529: {
                    530:        P p;
                    531:        UM mp;
                    532:        int r,mod;
                    533:
                    534:        p = (P)ARG0(arg);
                    535:        if ( !p ) {
                    536:                *rp = 0; return;
                    537:        }
                    538:        mp = W_UMALLOC(UDEG(p));
                    539:        mod = QTOS((Q)ARG1(arg));
                    540:        ptoum(mod,p,mp);
                    541:        r = irred_check(mp,mod);
                    542:        if ( r )
                    543:                *rp = ONE;
                    544:        else
                    545:                *rp = 0;
                    546: }
                    547:
                    548: void Pnfctr_mod(arg,rp)
                    549: NODE arg;
                    550: Q *rp;
                    551: {
                    552:        P p;
                    553:        UM mp;
                    554:        int r,mod;
                    555:
                    556:        p = (P)ARG0(arg);
                    557:        if ( !p ) {
                    558:                *rp = 0; return;
                    559:        }
                    560:        mp = W_UMALLOC(UDEG(p));
                    561:        mod = QTOS((Q)ARG1(arg));
                    562:        ptoum(mod,p,mp);
                    563:        r = nfctr_mod(mp,mod);
                    564:        STOQ(r,*rp);
                    565: }
                    566:
                    567: void Pddd_tab(arg,rp)
                    568: NODE arg;
                    569: VECT *rp;
                    570: {
                    571:        P p;
                    572:        UM mp,t,q,r1,w,w1;
                    573:        UM *r,*s;
                    574:        int dr,mod,n,i;
                    575:        VECT result;
                    576:        V v;
                    577:
                    578:        p = (P)ARG0(arg); mod = QTOS((Q)ARG1(arg));
                    579:        v = VR(p);
                    580:        n = UDEG(p); mp = W_UMALLOC(n);
                    581:        ptoum(mod,p,mp);
                    582:        r = (UM *)W_ALLOC(n); s = (UM *)W_ALLOC(n);
                    583:        r[0] = UMALLOC(0); DEG(r[0]) = 0; COEF(r[0])[0] = 1;
                    584:        t = W_UMALLOC(mod); bzero(COEF(t),sizeof(int)*(mod+1));
                    585:        DEG(t) = mod; COEF(t)[mod] = 1;
                    586:        q = W_UMALLOC(mod);
                    587:        dr = divum(mod,t,mp,q);
                    588:        DEG(t) = dr; r[1] = r1 = UMALLOC(dr); cpyum(t,r1);
                    589:        s[0] = W_UMALLOC(dr); cpyum(t,s[0]);
                    590:        w = W_UMALLOC(n); bzero(COEF(w),sizeof(int)*(n+1));
                    591:        w1 = W_UMALLOC(2*n); bzero(COEF(w1),sizeof(int)*(2*n+1));
                    592:        for ( i = 1; i < n; i++ ) {
                    593:                DEG(w) = i; COEF(w)[i-1] = 0; COEF(w)[i] = 1;
                    594:                mulum(mod,r1,w,w1);
                    595:                dr = divum(mod,w1,mp,q); DEG(w1) = dr;
                    596:                s[i] = W_UMALLOC(dr); cpyum(w1,s[i]);
                    597:        }
                    598:        for ( i = 2; i < n; i++ ) {
                    599:                mult_mod_tab(r[i-1],mod,s,w,n);
                    600:                r[i] = UMALLOC(DEG(w)); cpyum(w,r[i]);
                    601:        }
                    602:        MKVECT(result,n);
                    603:        for ( i = 0; i < n; i++ )
                    604:                umtop(v,r[i],(P *)&BDY(result)[i]);
                    605:        *rp = result;
                    606: }

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