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

Annotation of OpenXM_contrib2/asir2000/engine/distm.c, Revision 1.13

1.5       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.6       noro       26:  * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.5       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.13    ! noro       48:  * $OpenXM: OpenXM_contrib2/asir2000/engine/distm.c,v 1.12 2003/07/20 08:55:23 noro Exp $
1.5       noro       49: */
1.1       noro       50: #include "ca.h"
                     51: #include "inline.h"
                     52:
                     53: extern int (*cmpdl)();
1.2       noro       54: extern int do_weyl;
                     55:
1.9       noro       56: void ptomd(VL vl,int mod,VL dvl,P p,DP *pr)
1.1       noro       57: {
                     58:        P t;
                     59:
                     60:        ptomp(mod,p,&t);
                     61:        mptomd(vl,mod,dvl,t,pr);
                     62: }
                     63:
1.9       noro       64: void mptomd(VL vl,int mod,VL dvl,P p,DP *pr)
1.1       noro       65: {
                     66:        int n,i;
                     67:        VL tvl;
                     68:        V v;
                     69:        DL d;
                     70:        MP m;
                     71:        DCP dc;
                     72:        DP r,s,t,u;
                     73:        P x,c;
                     74:
                     75:        if ( !p )
                     76:                *pr = 0;
                     77:        else {
                     78:                for ( n = 0, tvl = dvl; tvl; tvl = NEXT(tvl), n++ );
                     79:                if ( NUM(p) ) {
                     80:                        NEWDL(d,n);
                     81:                        NEWMP(m); m->dl = d; C(m) = p; NEXT(m) = 0; MKDP(n,m,*pr);
                     82:                } else {
                     83:                        for ( i = 0, tvl = dvl, v = VR(p);
                     84:                                tvl && tvl->v != v; tvl = NEXT(tvl), i++ );
                     85:                        if ( !tvl ) {
                     86:                                for ( dc = DC(p), s = 0, MKV(v,x); dc; dc = NEXT(dc) ) {
                     87:                                        mptomd(vl,mod,dvl,COEF(dc),&t); pwrmp(vl,mod,x,DEG(dc),&c);
                     88:                                        mulmdc(vl,mod,t,c,&r); addmd(vl,mod,r,s,&t); s = t;
                     89:                                }
                     90:                                *pr = s;
                     91:                        } else {
                     92:                                for ( dc = DC(p), s = 0; dc; dc = NEXT(dc) ) {
                     93:                                        mptomd(vl,mod,dvl,COEF(dc),&t);
1.10      noro       94:                                        NEWDL(d,n); d->d[i] = QTOS(DEG(dc));
                     95:                                        d->td = MUL_WEIGHT(d->d[i],i);
1.1       noro       96:                                        NEWMP(m); m->dl = d; C(m) = (P)ONEM; NEXT(m) = 0; MKDP(n,m,u);
1.2       noro       97:                                        comm_mulmd(vl,mod,t,u,&r); addmd(vl,mod,r,s,&t); s = t;
1.1       noro       98:                                }
                     99:                                *pr = s;
                    100:                        }
                    101:                }
                    102:        }
                    103: }
                    104:
1.9       noro      105: void mdtop(VL vl,int mod,VL dvl,DP p,P *pr)
1.1       noro      106: {
                    107:        int n,i;
                    108:        DL d;
                    109:        MP m;
                    110:        P r,s,t,u,w;
                    111:        Q q;
                    112:        VL tvl;
                    113:
                    114:        if ( !p )
                    115:                *pr = 0;
                    116:        else {
                    117:                for ( n = p->nv, m = BDY(p), s = 0; m; m = NEXT(m) ) {
                    118:                        for ( i = 0, t = C(m), d = m->dl, tvl = dvl;
                    119:                                i < n; tvl = NEXT(tvl), i++ ) {
                    120:                                MKMV(tvl->v,r); STOQ(d->d[i],q); pwrmp(vl,mod,r,q,&u);
                    121:                                mulmp(vl,mod,t,u,&w); t = w;
                    122:                        }
                    123:                        addmp(vl,mod,s,t,&u); s = u;
                    124:                }
                    125:                mptop(s,pr);
                    126:        }
                    127: }
                    128:
1.9       noro      129: void addmd(VL vl,int mod,DP p1,DP p2,DP *pr)
1.1       noro      130: {
                    131:        int n;
                    132:        MP m1,m2,mr,mr0;
                    133:        P t;
                    134:        int tmp;
                    135:        MQ q;
                    136:
                    137:        if ( !p1 )
                    138:                *pr = p2;
                    139:        else if ( !p2 )
                    140:                *pr = p1;
                    141:        else {
                    142:                for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; )
                    143:                        switch ( (*cmpdl)(n,m1->dl,m2->dl) ) {
                    144:                                case 0:
                    145:                                        if ( NUM(C(m1)) && NUM(C(m2)) ) {
                    146:                                                tmp = (CONT((MQ)C(m1))+CONT((MQ)C(m2))) - mod;
                    147:                                                if ( tmp < 0 )
                    148:                                                        tmp += mod;
                    149:                                                if ( tmp ) {
                    150:                                                        STOMQ(tmp,q); t = (P)q;
                    151:                                                } else
                    152:                                                        t = 0;
                    153:                                        } else
                    154:                                                addmp(vl,mod,C(m1),C(m2),&t);
                    155:                                        if ( t ) {
                    156:                                                NEXTMP(mr0,mr); mr->dl = m1->dl; C(mr) = t;
                    157:                                        }
                    158:                                        m1 = NEXT(m1); m2 = NEXT(m2); break;
                    159:                                case 1:
                    160:                                        NEXTMP(mr0,mr); mr->dl = m1->dl; C(mr) = C(m1);
                    161:                                        m1 = NEXT(m1); break;
                    162:                                case -1:
                    163:                                        NEXTMP(mr0,mr); mr->dl = m2->dl; C(mr) = C(m2);
                    164:                                        m2 = NEXT(m2); break;
                    165:                        }
                    166:                if ( !mr0 )
                    167:                        if ( m1 )
                    168:                                mr0 = m1;
                    169:                        else if ( m2 )
                    170:                                mr0 = m2;
                    171:                        else {
                    172:                                *pr = 0;
                    173:                                return;
                    174:                        }
                    175:                else if ( m1 )
                    176:                        NEXT(mr) = m1;
                    177:                else if ( m2 )
                    178:                        NEXT(mr) = m2;
                    179:                else
                    180:                        NEXT(mr) = 0;
                    181:                MKDP(NV(p1),mr0,*pr);
                    182:                if ( *pr )
                    183:                        (*pr)->sugar = MAX(p1->sugar,p2->sugar);
                    184:        }
                    185: }
                    186:
1.9       noro      187: void submd(VL vl,int mod,DP p1,DP p2,DP *pr)
1.1       noro      188: {
                    189:        DP t;
                    190:
                    191:        if ( !p2 )
                    192:                *pr = p1;
                    193:        else {
                    194:                chsgnmd(mod,p2,&t); addmd(vl,mod,p1,t,pr);
                    195:        }
                    196: }
                    197:
1.9       noro      198: void chsgnmd(int mod,DP p,DP *pr)
1.1       noro      199: {
                    200:        MP m,mr,mr0;
                    201:
                    202:        if ( !p )
                    203:                *pr = 0;
                    204:        else {
                    205:                for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
                    206:                        NEXTMP(mr0,mr); chsgnmp(mod,C(m),&C(mr)); mr->dl = m->dl;
                    207:                }
                    208:                NEXT(mr) = 0; MKDP(NV(p),mr0,*pr);
                    209:                if ( *pr )
                    210:                        (*pr)->sugar = p->sugar;
                    211:        }
                    212: }
                    213:
1.9       noro      214: void mulmd(VL vl,int mod,DP p1,DP p2,DP *pr)
1.1       noro      215: {
1.2       noro      216:        if ( !do_weyl )
                    217:                comm_mulmd(vl,mod,p1,p2,pr);
                    218:        else
                    219:                weyl_mulmd(vl,mod,p1,p2,pr);
                    220: }
                    221:
1.9       noro      222: void comm_mulmd(VL vl,int mod,DP p1,DP p2,DP *pr)
1.2       noro      223: {
                    224:        MP m;
                    225:        DP s,t,u;
                    226:        int i,l,l1;
                    227:        static MP *w;
                    228:        static int wlen;
                    229:
                    230:        if ( !p1 || !p2 )
                    231:                *pr = 0;
                    232:        else if ( OID(p1) <= O_P )
                    233:                mulmdc(vl,mod,p2,(P)p1,pr);
                    234:        else if ( OID(p2) <= O_P )
                    235:                mulmdc(vl,mod,p1,(P)p2,pr);
                    236:        else {
                    237:                for ( m = BDY(p1), l1 = 0; m; m = NEXT(m), l1++ );
                    238:                for ( m = BDY(p2), l = 0; m; m = NEXT(m), l++ );
                    239:                if ( l1 < l ) {
                    240:                        t = p1; p1 = p2; p2 = t;
                    241:                        l = l1;
                    242:                }
                    243:                if ( l > wlen ) {
                    244:                        if ( w ) GC_free(w);
                    245:                        w = (MP *)MALLOC(l*sizeof(MP));
                    246:                        wlen = l;
                    247:                }
                    248:                for ( m = BDY(p2), i = 0; i < l; m = NEXT(m), i++ )
                    249:                        w[i] = m;
                    250:                for ( s = 0, i = l-1; i >= 0; i-- ) {
                    251:                        mulmdm(vl,mod,p1,w[i],&t); addmd(vl,mod,s,t,&u); s = u;
                    252:                }
                    253:                bzero(w,l*sizeof(MP));
                    254:                *pr = s;
                    255:        }
                    256: }
                    257:
1.9       noro      258: void weyl_mulmd(VL vl,int mod,DP p1,DP p2,DP *pr)
1.2       noro      259: {
1.1       noro      260:        MP m;
                    261:        DP s,t,u;
1.9       noro      262:        int i,l;
1.2       noro      263:        static MP *w;
                    264:        static int wlen;
1.1       noro      265:
                    266:        if ( !p1 || !p2 )
                    267:                *pr = 0;
                    268:        else if ( OID(p1) <= O_P )
                    269:                mulmdc(vl,mod,p2,(P)p1,pr);
                    270:        else if ( OID(p2) <= O_P )
                    271:                mulmdc(vl,mod,p1,(P)p2,pr);
                    272:        else {
1.2       noro      273:                for ( m = BDY(p2), l = 0; m; m = NEXT(m), l++ );
                    274:                if ( l > wlen ) {
                    275:                        if ( w ) GC_free(w);
                    276:                        w = (MP *)MALLOC(l*sizeof(MP));
                    277:                        wlen = l;
                    278:                }
                    279:                for ( m = BDY(p2), i = 0; i < l; m = NEXT(m), i++ )
                    280:                        w[i] = m;
                    281:                for ( s = 0, i = l-1; i >= 0; i-- ) {
                    282:                        weyl_mulmdm(vl,mod,p1,w[i],&t); addmd(vl,mod,s,t,&u); s = u;
1.1       noro      283:                }
1.2       noro      284:                bzero(w,l*sizeof(MP));
1.1       noro      285:                *pr = s;
                    286:        }
                    287: }
                    288:
1.9       noro      289: void mulmdm(VL vl,int mod,DP p,MP m0,DP *pr)
1.1       noro      290: {
                    291:        MP m,mr,mr0;
                    292:        P c;
                    293:        DL d;
                    294:        int n,t;
                    295:        MQ q;
                    296:
                    297:        if ( !p )
                    298:                *pr = 0;
                    299:        else {
                    300:                for ( mr0 = 0, m = BDY(p), c = C(m0), d = m0->dl, n = NV(p);
                    301:                        m; m = NEXT(m) ) {
                    302:                        NEXTMP(mr0,mr);
                    303:                        if ( NUM(C(m)) && NUM(c) ) {
                    304:                                t = dmar(((MQ)(C(m)))->cont,((MQ)c)->cont,0,mod);
                    305:                                STOMQ(t,q); C(mr) = (P)q;
                    306:                        } else
                    307:                                mulmp(vl,mod,C(m),c,&C(mr));
                    308:                        adddl(n,m->dl,d,&mr->dl);
                    309:                }
                    310:                NEXT(mr) = 0; MKDP(NV(p),mr0,*pr);
                    311:                if ( *pr )
                    312:                        (*pr)->sugar = p->sugar + m0->dl->td;
                    313:        }
                    314: }
                    315:
1.9       noro      316: void weyl_mulmdm(VL vl,int mod,DP p,MP m0,DP *pr)
1.2       noro      317: {
                    318:        DP r,t,t1;
                    319:        MP m;
                    320:        int n,l,i;
                    321:        static MP *w;
                    322:        static int wlen;
                    323:
                    324:        if ( !p )
                    325:                *pr = 0;
                    326:        else {
                    327:                for ( m = BDY(p), l = 0; m; m = NEXT(m), l++ );
                    328:                if ( l > wlen ) {
                    329:                        if ( w ) GC_free(w);
                    330:                        w = (MP *)MALLOC(l*sizeof(MP));
                    331:                        wlen = l;
                    332:                }
                    333:                for ( m = BDY(p), i = 0; i < l; m = NEXT(m), i++ )
                    334:                        w[i] = m;
                    335:                for ( r = 0, i = l-1, n = NV(p); i >= 0; i-- ) {
                    336:                        weyl_mulmmm(vl,mod,w[i],m0,n,&t);
                    337:                        addmd(vl,mod,r,t,&t1); r = t1;
                    338:                }
                    339:                bzero(w,l*sizeof(MP));
                    340:                if ( r )
                    341:                        r->sugar = p->sugar + m0->dl->td;
                    342:                *pr = r;
                    343:        }
                    344: }
                    345:
                    346: /* m0 = x0^d0*x1^d1*... * dx0^d(n/2)*dx1^d(n/2+1)*... */
                    347:
1.9       noro      348: void weyl_mulmmm(VL vl,int mod,MP m0,MP m1,int n,DP *pr)
1.2       noro      349: {
1.9       noro      350:        MP mr,mr0;
1.2       noro      351:        MQ mq;
                    352:        DP r,t,t1;
1.9       noro      353:        P c,c0,c1;
1.2       noro      354:        DL d,d0,d1;
1.3       noro      355:        int i,j,a,b,k,l,n2,s,min;
1.2       noro      356:        static int *tab;
                    357:        static int tablen;
                    358:
                    359:        if ( !m0 || !m1 )
                    360:                *pr = 0;
                    361:        else {
                    362:                c0 = C(m0); c1 = C(m1);
                    363:                mulmp(vl,mod,c0,c1,&c);
                    364:                d0 = m0->dl; d1 = m1->dl;
                    365:                n2 = n>>1;
                    366:                if ( n & 1 ) {
                    367:                        /* homogenized computation; dx-xd=h^2 */
                    368:                        /* offset of h-degree */
1.3       noro      369:                        NEWDL(d,n);
                    370:                        d->td = d->d[n-1] = d0->d[n-1]+d1->d[n-1];
1.4       noro      371:                        NEWMP(mr); mr->c = (P)ONEM; mr->dl = d; NEXT(mr) = 0;
1.3       noro      372:                        MKDP(n,mr,r); r->sugar = d->td;
                    373:                } else
                    374:                        r = (DP)ONEM;
                    375:                for ( i = 0; i < n2; i++ ) {
                    376:                        a = d0->d[i]; b = d1->d[n2+i];
                    377:                        k = d0->d[n2+i]; l = d1->d[i];
1.10      noro      378:
1.3       noro      379:                        /* degree of xi^a*(Di^k*xi^l)*Di^b */
1.10      noro      380:                        a += l;
                    381:                        b += k;
                    382:                        s = MUL_WEIGHT(a,i)+MUL_WEIGHT(b,n2+i);
                    383:
1.3       noro      384:                        /* compute xi^a*(Di^k*xi^l)*Di^b */
                    385:                        min = MIN(k,l);
                    386:
                    387:                        if ( min+1 > tablen ) {
                    388:                                if ( tab ) GC_free(tab);
                    389:                                tab = (int *)MALLOC((min+1)*sizeof(int));
                    390:                                tablen = min+1;
                    391:                        }
                    392:                        mkwcm(k,l,mod,tab);
                    393:                        if ( n & 1 )
1.2       noro      394:                                for ( mr0 = 0, j = 0; j <= min; j++ ) {
1.3       noro      395:                                        NEXTMP(mr0,mr); NEWDL(d,n);
1.10      noro      396:                                        d->d[i] = a-j; d->d[n2+i] = b-j;
1.3       noro      397:                                        d->td = s;
1.10      noro      398:                                        d->d[n-1] = s-(MUL_WEIGHT(a-j,i)+MUL_WEIGHT(b-j,n2+i));
1.3       noro      399:                                        STOMQ(tab[j],mq); mr->c = (P)mq; mr->dl = d;
1.2       noro      400:                                }
1.3       noro      401:                        else
1.2       noro      402:                                for ( mr0 = 0, s = 0, j = 0; j <= min; j++ ) {
1.3       noro      403:                                        NEXTMP(mr0,mr); NEWDL(d,n);
1.10      noro      404:                                        d->d[i] = a-j; d->d[n2+i] = b-j;
                    405:                                        d->td = MUL_WEIGHT(a-j,i)+MUL_WEIGHT(b-j,n2+i); /* XXX */
1.2       noro      406:                                        s = MAX(s,d->td); /* XXX */
1.3       noro      407:                                        STOMQ(tab[j],mq); mr->c = (P)mq; mr->dl = d;
1.2       noro      408:                                }
1.3       noro      409:                        bzero(tab,(min+1)*sizeof(int));
                    410:                        if ( mr0 )
                    411:                                NEXT(mr) = 0;
                    412:                        MKDP(n,mr0,t);
                    413:                        if ( t )
                    414:                                t->sugar = s;
                    415:                        comm_mulmd(vl,mod,r,t,&t1); r = t1;
                    416:                }
1.2       noro      417:                mulmdc(vl,mod,r,c,pr);
                    418:        }
                    419: }
                    420:
1.9       noro      421: void mulmdc(VL vl,int mod,DP p,P c,DP *pr)
1.1       noro      422: {
                    423:        MP m,mr,mr0;
                    424:        int t;
                    425:        MQ q;
                    426:
                    427:        if ( !p || !c )
                    428:                *pr = 0;
                    429:        else {
                    430:                for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
                    431:                        NEXTMP(mr0,mr);
                    432:                        if ( NUM(C(m)) && NUM(c) ) {
                    433:                                t = dmar(((MQ)(C(m)))->cont,((MQ)c)->cont,0,mod);
                    434:                                STOMQ(t,q); C(mr) = (P)q;
                    435:                        } else
                    436:                                mulmp(vl,mod,C(m),c,&C(mr));
                    437:                        mr->dl = m->dl;
                    438:                }
                    439:                NEXT(mr) = 0; MKDP(NV(p),mr0,*pr);
                    440:                if ( *pr )
                    441:                        (*pr)->sugar = p->sugar;
                    442:        }
                    443: }
                    444:
1.9       noro      445: void divsmdc(VL vl,int mod,DP p,P c,DP *pr)
1.1       noro      446: {
                    447:        MP m,mr,mr0;
                    448:
                    449:        if ( !c )
                    450:                error("disvsdc : division by 0");
                    451:        else if ( !p )
                    452:                *pr = 0;
                    453:        else {
                    454:                for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
                    455:                        NEXTMP(mr0,mr); divsmp(vl,mod,C(m),c,&C(mr)); mr->dl = m->dl;
                    456:                }
                    457:                NEXT(mr) = 0; MKDP(NV(p),mr0,*pr);
                    458:                if ( *pr )
                    459:                        (*pr)->sugar = p->sugar;
                    460:        }
                    461: }
                    462:
1.9       noro      463: void _dtop_mod(VL vl,VL dvl,DP p,P *pr)
1.1       noro      464: {
                    465:        int n,i;
                    466:        DL d;
                    467:        MP m;
                    468:        P r,s,t,u,w;
                    469:        Q q;
                    470:        VL tvl;
                    471:
                    472:        if ( !p )
                    473:                *pr = 0;
                    474:        else {
                    475:                for ( n = p->nv, m = BDY(p), s = 0; m; m = NEXT(m) ) {
                    476:                        i = ITOS(m->c); STOQ(i,q); t = (P)q;
                    477:                        for ( i = 0, d = m->dl, tvl = dvl;
                    478:                                i < n; tvl = NEXT(tvl), i++ ) {
                    479:                                MKV(tvl->v,r); STOQ(d->d[i],q); pwrp(vl,r,q,&u);
                    480:                                mulp(vl,t,u,&w); t = w;
                    481:                        }
                    482:                        addp(vl,s,t,&u); s = u;
                    483:                }
                    484:                *pr = s;
                    485:        }
                    486: }
                    487:
1.9       noro      488: void _dp_mod(DP p,int mod,NODE subst,DP *rp)
1.1       noro      489: {
                    490:        MP m,mr,mr0;
                    491:        P t,s;
                    492:        NODE tn;
                    493:
                    494:        if ( !p )
                    495:                *rp = 0;
                    496:        else {
                    497:                for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
                    498:                        for ( tn = subst, s = m->c; tn; tn = NEXT(NEXT(tn)) ) {
                    499:                                substp(CO,s,BDY(tn),BDY(NEXT(tn)),&t);
                    500:                                s = t;
                    501:                        }
                    502:                        ptomp(mod,s,&t);
                    503:                        if ( t ) {
                    504:                                NEXTMP(mr0,mr); mr->c = STOI(CONT((MQ)t)); mr->dl = m->dl;
                    505:                        }
                    506:                }
                    507:                if ( mr0 ) {
                    508:                        NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
                    509:                } else
                    510:                        *rp = 0;
                    511:        }
                    512: }
                    513:
1.9       noro      514: void _dp_monic(DP p,int mod,DP *rp)
1.2       noro      515: {
                    516:        MP m,mr,mr0;
                    517:        int c,c1;
                    518:
                    519:        if ( !p )
                    520:                *rp = 0;
                    521:        else {
                    522:                c = invm(ITOS(BDY(p)->c),mod);
                    523:                for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
                    524:                        c1 = dmar(ITOS(m->c),c,0,mod);
                    525:                        NEXTMP(mr0,mr); mr->c = STOI(c1); mr->dl = m->dl;
                    526:                }
                    527:                NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
                    528:        }
1.1       noro      529: }
                    530:
1.9       noro      531: void _printdp(DP d)
1.1       noro      532: {
                    533:        int n,i;
                    534:        MP m;
                    535:        DL dl;
                    536:
                    537:        if ( !d ) {
                    538:                printf("0"); return;
                    539:        }
                    540:        for ( n = d->nv, m = BDY(d); m; m = NEXT(m) ) {
                    541:                printf("%d*<<",ITOS(m->c));
                    542:                for ( i = 0, dl = m->dl; i < n-1; i++ )
                    543:                        printf("%d,",dl->d[i]);
                    544:                printf("%d",dl->d[i]);
                    545:                printf(">>");
                    546:                if ( NEXT(m) )
                    547:                        printf("+");
                    548:        }
1.8       noro      549: }
                    550:
                    551: /* merge p1 and p2 into pr */
                    552:
1.9       noro      553: void addmd_destructive(int mod,DP p1,DP p2,DP *pr)
1.8       noro      554: {
                    555:        int n;
                    556:        MP m1,m2,mr,mr0,s;
                    557:        int t;
                    558:
                    559:        if ( !p1 )
                    560:                *pr = p2;
                    561:        else if ( !p2 )
                    562:                *pr = p1;
                    563:        else {
                    564:                for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; )
                    565:                        switch ( (*cmpdl)(n,m1->dl,m2->dl) ) {
                    566:                                case 0:
                    567:                                        t = (ITOS(C(m1))+ITOS(C(m2))) - mod;
                    568:                                        if ( t < 0 )
                    569:                                                t += mod;
                    570:                                        s = m1; m1 = NEXT(m1);
                    571:                                        if ( t ) {
                    572:                                                NEXTMP2(mr0,mr,s); C(mr) = STOI(t);
                    573:                                        }
                    574:                                        s = m2; m2 = NEXT(m2);
                    575:                                        break;
                    576:                                case 1:
                    577:                                        s = m1; m1 = NEXT(m1); NEXTMP2(mr0,mr,s);
                    578:                                        break;
                    579:                                case -1:
                    580:                                        s = m2; m2 = NEXT(m2); NEXTMP2(mr0,mr,s);
                    581:                                        break;
                    582:                        }
                    583:                if ( !mr0 )
                    584:                        if ( m1 )
                    585:                                mr0 = m1;
                    586:                        else if ( m2 )
                    587:                                mr0 = m2;
                    588:                        else {
                    589:                                *pr = 0;
                    590:                                return;
                    591:                        }
                    592:                else if ( m1 )
                    593:                        NEXT(mr) = m1;
                    594:                else if ( m2 )
                    595:                        NEXT(mr) = m2;
                    596:                else
                    597:                        NEXT(mr) = 0;
                    598:                MKDP(NV(p1),mr0,*pr);
                    599:                if ( *pr )
                    600:                        (*pr)->sugar = MAX(p1->sugar,p2->sugar);
                    601:        }
                    602: }
                    603:
1.9       noro      604: void mulmd_dup(int mod,DP p1,DP p2,DP *pr)
1.8       noro      605: {
                    606:        if ( !do_weyl )
                    607:                comm_mulmd_dup(mod,p1,p2,pr);
                    608:        else
                    609:                weyl_mulmd_dup(mod,p1,p2,pr);
                    610: }
                    611:
1.9       noro      612: void comm_mulmd_dup(int mod,DP p1,DP p2,DP *pr)
1.8       noro      613: {
                    614:        MP m;
                    615:        DP s,t,u;
                    616:        int i,l,l1;
                    617:        static MP *w;
                    618:        static int wlen;
                    619:
                    620:        if ( !p1 || !p2 )
                    621:                *pr = 0;
                    622:        else {
                    623:                for ( m = BDY(p1), l1 = 0; m; m = NEXT(m), l1++ );
                    624:                for ( m = BDY(p2), l = 0; m; m = NEXT(m), l++ );
                    625:                if ( l1 < l ) {
                    626:                        t = p1; p1 = p2; p2 = t;
                    627:                        l = l1;
                    628:                }
                    629:                if ( l > wlen ) {
                    630:                        if ( w ) GC_free(w);
                    631:                        w = (MP *)MALLOC(l*sizeof(MP));
                    632:                        wlen = l;
                    633:                }
                    634:                for ( m = BDY(p2), i = 0; i < l; m = NEXT(m), i++ )
                    635:                        w[i] = m;
                    636:                for ( s = 0, i = l-1; i >= 0; i-- ) {
                    637:                        mulmdm_dup(mod,p1,w[i],&t); addmd_destructive(mod,s,t,&u); s = u;
                    638:                }
                    639:                bzero(w,l*sizeof(MP));
                    640:                *pr = s;
                    641:        }
                    642: }
                    643:
1.9       noro      644: void weyl_mulmd_dup(int mod,DP p1,DP p2,DP *pr)
1.8       noro      645: {
                    646:        MP m;
                    647:        DP s,t,u;
1.9       noro      648:        int i,l;
1.8       noro      649:        static MP *w;
                    650:        static int wlen;
                    651:
                    652:        if ( !p1 || !p2 )
                    653:                *pr = 0;
                    654:        else {
                    655:                for ( m = BDY(p1), l = 0; m; m = NEXT(m), l++ );
                    656:                if ( l > wlen ) {
                    657:                        if ( w ) GC_free(w);
                    658:                        w = (MP *)MALLOC(l*sizeof(MP));
                    659:                        wlen = l;
                    660:                }
                    661:                for ( m = BDY(p1), i = 0; i < l; m = NEXT(m), i++ )
                    662:                        w[i] = m;
                    663:                for ( s = 0, i = l-1; i >= 0; i-- ) {
                    664:                        weyl_mulmdm_dup(mod,w[i],p2,&t); addmd_destructive(mod,s,t,&u); s = u;
                    665:                }
                    666:                bzero(w,l*sizeof(MP));
                    667:                *pr = s;
                    668:        }
                    669: }
                    670:
1.9       noro      671: void mulmdm_dup(int mod,DP p,MP m0,DP *pr)
1.8       noro      672: {
                    673:        MP m,mr,mr0;
                    674:        DL d,dt,dm;
1.9       noro      675:        int c,n,i;
1.8       noro      676:        int *pt,*p1,*p2;
                    677:
                    678:        if ( !p )
                    679:                *pr = 0;
                    680:        else {
                    681:                for ( mr0 = 0, m = BDY(p), c = ITOS(C(m0)), d = m0->dl, n = NV(p);
                    682:                        m; m = NEXT(m) ) {
                    683:                        NEXTMP(mr0,mr);
                    684:                        C(mr) = STOI(dmar(ITOS(C(m)),c,0,mod));
                    685:                        NEWDL_NOINIT(dt,n); mr->dl = dt;
                    686:                        dm = m->dl;
                    687:                        dt->td = d->td + dm->td;
                    688:                        for ( i = 0, pt = dt->d, p1=d->d, p2 = dm->d; i < n; i++ )
                    689:                                *pt++ = *p1++ + *p2++;
                    690:                }
                    691:                NEXT(mr) = 0; MKDP(NV(p),mr0,*pr);
                    692:                if ( *pr )
                    693:                        (*pr)->sugar = p->sugar + m0->dl->td;
                    694:        }
                    695: }
                    696:
1.9       noro      697: void weyl_mulmdm_dup(int mod,MP m0,DP p,DP *pr)
1.8       noro      698: {
                    699:        DP r,t,t1;
                    700:        MP m;
                    701:        DL d0;
                    702:        int n,n2,l,i,j,tlen;
                    703:        static MP *w,*psum;
                    704:        static struct cdlm *tab;
                    705:        static int wlen;
                    706:        static int rtlen;
                    707:
                    708:        if ( !p )
                    709:                *pr = 0;
                    710:        else {
                    711:                for ( m = BDY(p), l = 0; m; m = NEXT(m), l++ );
                    712:                if ( l > wlen ) {
                    713:                        if ( w ) GC_free(w);
                    714:                        w = (MP *)MALLOC(l*sizeof(MP));
                    715:                        wlen = l;
                    716:                }
                    717:                for ( m = BDY(p), i = 0; i < l; m = NEXT(m), i++ )
                    718:                        w[i] = m;
                    719:                n = NV(p); n2 = n>>1;
                    720:                d0 = m0->dl;
                    721:
                    722:                for ( i = 0, tlen = 1; i < n2; i++ )
                    723:                        tlen *= d0->d[n2+i]+1;
                    724:                if ( tlen > rtlen ) {
                    725:                        if ( tab ) GC_free(tab);
                    726:                        if ( psum ) GC_free(psum);
                    727:                        rtlen = tlen;
                    728:                        tab = (struct cdlm *)MALLOC(rtlen*sizeof(struct cdlm));
                    729:                        psum = (MP *)MALLOC(rtlen*sizeof(MP));
                    730:                }
                    731:                bzero(psum,tlen*sizeof(MP));
                    732:                for ( i = l-1; i >= 0; i-- ) {
                    733:                        bzero(tab,tlen*sizeof(struct cdlm));
                    734:                        weyl_mulmmm_dup(mod,m0,w[i],n,tab,tlen);
                    735:                        for ( j = 0; j < tlen; j++ ) {
                    736:                                if ( tab[j].c ) {
                    737:                                        NEWMP(m); m->dl = tab[j].d;
                    738:                                        C(m) = STOI(tab[j].c); NEXT(m) = psum[j];
                    739:                                        psum[j] = m;
                    740:                                }
                    741:                        }
                    742:                }
                    743:                for ( j = tlen-1, r = 0; j >= 0; j-- )
                    744:                        if ( psum[j] ) {
                    745:                                MKDP(n,psum[j],t); addmd_destructive(mod,r,t,&t1); r = t1;
                    746:                        }
                    747:                if ( r )
                    748:                        r->sugar = p->sugar + m0->dl->td;
                    749:                *pr = r;
                    750:        }
                    751: }
                    752:
                    753: /* m0 = x0^d0*x1^d1*... * dx0^d(n/2)*dx1^d(n/2+1)*... */
                    754:
1.9       noro      755: void weyl_mulmmm_dup(int mod,MP m0,MP m1,int n,struct cdlm *rtab,int rtablen)
1.8       noro      756: {
1.9       noro      757:        int c,c0,c1;
1.8       noro      758:        DL d,d0,d1,dt;
1.9       noro      759:        int i,j,a,b,k,l,n2,s,min,curlen;
1.8       noro      760:        struct cdlm *p;
                    761:        static int *ctab;
                    762:        static struct cdlm *tab;
                    763:        static int tablen;
                    764:        static struct cdlm *tmptab;
                    765:        static int tmptablen;
                    766:
                    767:        if ( !m0 || !m1 ) {
                    768:                rtab[0].c = 0;
                    769:                rtab[0].d = 0;
                    770:                return;
                    771:        }
                    772:        c0 = ITOS(C(m0)); c1 = ITOS(C(m1));
                    773:        c = dmar(c0,c1,0,mod);
                    774:        d0 = m0->dl; d1 = m1->dl;
                    775:        n2 = n>>1;
                    776:        curlen = 1;
                    777:
                    778:        NEWDL(d,n);
                    779:        if ( n & 1 )
                    780:                /* offset of h-degree */
                    781:                d->td = d->d[n-1] = d0->d[n-1]+d1->d[n-1];
                    782:        else
                    783:                d->td = 0;
                    784:        rtab[0].c = c;
                    785:        rtab[0].d = d;
                    786:
                    787:        if ( rtablen > tmptablen ) {
                    788:                if ( tmptab ) GC_free(tmptab);
                    789:                tmptab = (struct cdlm *)MALLOC(rtablen*sizeof(struct cdlm));
                    790:                tmptablen = rtablen;
                    791:        }
                    792:
                    793:        for ( i = 0; i < n2; i++ ) {
                    794:                a = d0->d[i]; b = d1->d[n2+i];
                    795:                k = d0->d[n2+i]; l = d1->d[i];
1.10      noro      796:
                    797:                /* degree of xi^a*(Di^k*xi^l)*Di^b */
                    798:                a += l;
                    799:                b += k;
                    800:                s = MUL_WEIGHT(a,i)+MUL_WEIGHT(b,n2+i);
                    801:
1.8       noro      802:                if ( !k || !l ) {
                    803:                        for ( j = 0, p = rtab; j < curlen; j++, p++ ) {
                    804:                                if ( p->c ) {
                    805:                                        dt = p->d;
                    806:                                        dt->d[i] = a;
                    807:                                        dt->d[n2+i] = b;
                    808:                                        dt->td += s;
                    809:                                }
                    810:                        }
                    811:                        curlen *= k+1;
                    812:                        continue;
                    813:                }
                    814:                if ( k+1 > tablen ) {
                    815:                        if ( tab ) GC_free(tab);
                    816:                        if ( ctab ) GC_free(ctab);
                    817:                        tablen = k+1;
                    818:                        tab = (struct cdlm *)MALLOC(tablen*sizeof(struct cdlm));
                    819:                        ctab = (int *)MALLOC(tablen*sizeof(int));
                    820:                }
                    821:                /* compute xi^a*(Di^k*xi^l)*Di^b */
                    822:                min = MIN(k,l);
                    823:                mkwcm(k,l,mod,ctab);
                    824:                bzero(tab,(k+1)*sizeof(struct cdlm));
                    825:                /* n&1 != 0 => homogenized computation; dx-xd=h^2 */
                    826:                if ( n & 1 )
                    827:                        for ( j = 0; j <= min; j++ ) {
                    828:                                NEWDL(d,n);
1.10      noro      829:                                d->d[i] = a-j; d->d[n2+i] = b-j;
1.8       noro      830:                                d->td = s;
1.10      noro      831:                                d->d[n-1] = s-(MUL_WEIGHT(a-j,i)+MUL_WEIGHT(b-j,n2+i));
1.8       noro      832:                                tab[j].d = d;
                    833:                                tab[j].c = ctab[j];
                    834:                        }
                    835:                else
                    836:                        for ( j = 0; j <= min; j++ ) {
                    837:                                NEWDL(d,n);
1.10      noro      838:                                d->d[i] = a-j; d->d[n2+i] = b-j;
                    839:                                d->td = MUL_WEIGHT(a-j,i)+MUL_WEIGHT(b-j,n2+i); /* XXX */
1.8       noro      840:                                tab[j].d = d;
                    841:                                tab[j].c = ctab[j];
                    842:                        }
                    843:                comm_mulmd_tab_destructive(mod,n,rtab,curlen,tab,k+1);
                    844:                curlen *= k+1;
                    845:        }
                    846: }
                    847:
1.9       noro      848: void comm_mulmd_tab_destructive(int mod,int nv,struct cdlm *t,int n,struct cdlm *t1,int n1)
1.8       noro      849: {
                    850:        int i,j;
                    851:        struct cdlm *p;
                    852:        int c;
                    853:        DL d;
                    854:
                    855:        for ( j = 1, p = t+n; j < n1; j++ ) {
                    856:                c = t1[j].c;
                    857:                d = t1[j].d;
                    858:                if ( !c )
                    859:                        break;
                    860:                for ( i = 0; i < n; i++, p++ ) {
                    861:                        if ( t[i].c ) {
                    862:                                p->c = dmar(t[i].c,c,0,mod);
                    863:                                adddl_dup(nv,t[i].d,d,&p->d);
                    864:                        }
                    865:                }
                    866:        }
                    867:        c = t1[0].c;
                    868:        d = t1[0].d;
                    869:        for ( i = 0, p = t; i < n; i++, p++ )
                    870:                if ( t[i].c ) {
                    871:                        p->c = dmar(t[i].c,c,0,mod);
                    872:                        /* t[i].d += d */
                    873:                        adddl_destructive(nv,t[i].d,d);
                    874:                }
                    875: }
                    876:
1.9       noro      877: void adddl_dup(int n,DL d1,DL d2,DL *dr)
1.8       noro      878: {
                    879:        DL dt;
                    880:        int i;
                    881:
                    882:        NEWDL(dt,n);
                    883:        *dr = dt;
                    884:        dt->td = d1->td + d2->td;
                    885:        for ( i = 0; i < n; i++ )
                    886:                dt->d[i] = d1->d[i]+d2->d[i];
1.11      noro      887: }
                    888:
                    889: /* ------------------------------------------------------ */
                    890:
                    891: #if defined(__GNUC__)
                    892: #define INLINE inline
                    893: #elif defined(VISUAL)
                    894: #define INLINE __inline
                    895: #else
                    896: #define INLINE
                    897: #endif
                    898:
                    899: typedef struct oPGeoBucket {
                    900:        int m;
                    901:        struct oND *body[32];
                    902: } *PGeoBucket;
                    903:
                    904: typedef struct oND {
                    905:        struct oNM *body;
                    906:        int nv;
                    907:        int sugar;
                    908: } *ND;
                    909:
                    910: typedef struct oNM {
                    911:        struct oNM *next;
                    912:        int td;
                    913:        int c;
                    914:        unsigned int dl[1];
                    915: } *NM;
                    916:
                    917: typedef struct oND_pairs {
                    918:        struct oND_pairs *next;
                    919:        int i1,i2;
                    920:        int td,sugar;
                    921:        unsigned int lcm[1];
                    922: } *ND_pairs;
                    923:
                    924: static ND *nps;
                    925: int nd_mod,nd_nvar;
                    926: int is_rlex;
                    927: int nd_epw,nd_bpe,nd_wpd;
1.12      noro      928: unsigned int nd_mask[32];
                    929: unsigned int nd_mask0;
1.11      noro      930: NM _nm_free_list;
                    931: ND _nd_free_list;
                    932: ND_pairs _ndp_free_list;
                    933:
                    934: extern int Top,Reverse;
                    935: int nd_psn,nd_pslen;
                    936:
                    937: void GC_gcollect();
                    938: NODE append_one(NODE,int);
                    939:
                    940: #define HTD(d) ((d)->body->td)
                    941: #define HDL(d) ((d)->body->dl)
                    942: #define HC(d) ((d)->body->c)
                    943:
                    944: #define NEWND_pairs(m) if(!_ndp_free_list)_NDP_alloc(); (m)=_ndp_free_list; _ndp_free_list = NEXT(_ndp_free_list)
                    945: #define NEWNM(m) if(!_nm_free_list)_NM_alloc(); (m)=_nm_free_list; _nm_free_list = NEXT(_nm_free_list)
                    946: #define MKND(n,m,d) if(!_nd_free_list)_ND_alloc(); (d)=_nd_free_list; _nd_free_list = (ND)BDY(_nd_free_list); (d)->nv=(n); BDY(d)=(m)
                    947:
                    948: #define NEXTNM(r,c) \
                    949: if(!(r)){NEWNM(r);(c)=(r);}else{NEWNM(NEXT(c));(c)=NEXT(c);}
                    950: #define NEXTNM2(r,c,s) \
                    951: if(!(r)){(c)=(r)=(s);}else{NEXT(c)=(s);(c)=(s);}
                    952: #define FREENM(m) NEXT(m)=_nm_free_list; _nm_free_list=(m)
                    953: #define FREEND(m) BDY(m)=(NM)_nd_free_list; _nd_free_list=(m)
                    954:
                    955: #define NEXTND_pairs(r,c) \
                    956: if(!(r)){NEWND_pairs(r);(c)=(r);}else{NEWND_pairs(NEXT(c));(c)=NEXT(c);}
                    957:
                    958: ND_pairs crit_B( ND_pairs d, int s );
                    959: void nd_gr(LIST f,LIST v,int m,struct order_spec *ord,LIST *rp);
                    960: NODE nd_setup(NODE f);
                    961: int nd_newps(ND a);
                    962: ND_pairs nd_minp( ND_pairs d, ND_pairs *prest );
                    963: NODE update_base(NODE nd,int ndp);
                    964: static ND_pairs equivalent_pairs( ND_pairs d1, ND_pairs *prest );
                    965: int crit_2( int dp1, int dp2 );
                    966: ND_pairs crit_F( ND_pairs d1 );
                    967: ND_pairs crit_M( ND_pairs d1 );
                    968: ND_pairs nd_newpairs( NODE g, int t );
                    969: ND_pairs update_pairs( ND_pairs d, NODE /* of index */ g, int t);
                    970: NODE nd_gb(NODE f);
                    971: void nd_free_private_storage();
                    972: void _NM_alloc();
                    973: void _ND_alloc();
                    974: int ndl_td(unsigned int *d);
                    975: ND nd_add(ND p1,ND p2);
                    976: ND nd_mul_nm(ND p,NM m0);
1.13    ! noro      977: ND nd_mul_term(ND p,int td,unsigned int *d);
1.11      noro      978: ND nd_sp(ND_pairs p);
1.12      noro      979: ND nd_find_reducer(ND g);
                    980: ND nd_nf(ND g,int full);
1.11      noro      981: void ndl_print(unsigned int *dl);
                    982: void nd_print(ND p);
                    983: void ndp_print(ND_pairs d);
                    984: int nd_length(ND p);
                    985: void nd_monic(ND p);
1.13    ! noro      986: void nd_mul_c(ND p,int mul);
1.11      noro      987:
                    988: void nd_free_private_storage()
                    989: {
                    990:        _nd_free_list = 0;
                    991:        _nm_free_list = 0;
                    992:        GC_gcollect();
                    993: }
                    994:
                    995: void _NM_alloc()
                    996: {
                    997:        NM p;
                    998:        int i;
                    999:
1.12      noro     1000:        for ( i = 0; i < 10240; i++ ) {
1.11      noro     1001:                p = (NM)GC_malloc(sizeof(struct oNM)+(nd_wpd-1)*sizeof(unsigned int));
                   1002:                p->next = _nm_free_list; _nm_free_list = p;
                   1003:        }
                   1004: }
                   1005:
                   1006: void _ND_alloc()
                   1007: {
                   1008:        ND p;
                   1009:        int i;
                   1010:
1.13    ! noro     1011:        for ( i = 0; i < 1024; i++ ) {
1.11      noro     1012:                p = (ND)GC_malloc(sizeof(struct oND));
                   1013:                p->body = (NM)_nd_free_list; _nd_free_list = p;
                   1014:        }
                   1015: }
                   1016:
                   1017: void _NDP_alloc()
                   1018: {
                   1019:        ND_pairs p;
                   1020:        int i;
                   1021:
1.12      noro     1022:        for ( i = 0; i < 10240; i++ ) {
1.11      noro     1023:                p = (ND_pairs)GC_malloc(sizeof(struct oND_pairs)
                   1024:                        +(nd_wpd-1)*sizeof(unsigned int));
                   1025:                p->next = _ndp_free_list; _ndp_free_list = p;
                   1026:        }
                   1027: }
                   1028:
                   1029: INLINE nd_length(ND p)
                   1030: {
                   1031:        NM m;
                   1032:        int i;
                   1033:
                   1034:        if ( !p )
                   1035:                return 0;
                   1036:        else {
                   1037:                for ( i = 0, m = BDY(p); m; m = NEXT(m), i++ );
                   1038:                return i;
                   1039:        }
                   1040: }
                   1041:
                   1042: INLINE int ndl_reducible(unsigned int *d1,unsigned int *d2)
                   1043: {
                   1044:        unsigned int u1,u2;
1.12      noro     1045:        int i,j;
1.11      noro     1046:
                   1047:        switch ( nd_bpe ) {
                   1048:                case 4:
                   1049:                        for ( i = 0; i < nd_wpd; i++ ) {
                   1050:                                u1 = d1[i]; u2 = d2[i];
                   1051:                                if ( (u1&0xf0000000) < (u2&0xf0000000) ) return 0;
                   1052:                                if ( (u1&0xf000000) < (u2&0xf000000) ) return 0;
                   1053:                                if ( (u1&0xf00000) < (u2&0xf00000) ) return 0;
                   1054:                                if ( (u1&0xf0000) < (u2&0xf0000) ) return 0;
                   1055:                                if ( (u1&0xf000) < (u2&0xf000) ) return 0;
                   1056:                                if ( (u1&0xf00) < (u2&0xf00) ) return 0;
                   1057:                                if ( (u1&0xf0) < (u2&0xf0) ) return 0;
                   1058:                                if ( (u1&0xf) < (u2&0xf) ) return 0;
                   1059:                        }
                   1060:                        return 1;
                   1061:                        break;
1.13    ! noro     1062:                case 6:
        !          1063:                        for ( i = 0; i < nd_wpd; i++ ) {
        !          1064:                                u1 = d1[i]; u2 = d2[i];
        !          1065:                                if ( (u1&0x3f000000) < (u2&0x3f000000) ) return 0;
        !          1066:                                if ( (u1&0xfc0000) < (u2&0xfc0000) ) return 0;
        !          1067:                                if ( (u1&0x3f000) < (u2&0x3f000) ) return 0;
        !          1068:                                if ( (u1&0xfc0) < (u2&0xfc0) ) return 0;
        !          1069:                                if ( (u1&0x3f) < (u2&0x3f) ) return 0;
        !          1070:                        }
        !          1071:                        return 1;
        !          1072:                        break;
1.11      noro     1073:                case 8:
                   1074:                        for ( i = 0; i < nd_wpd; i++ ) {
                   1075:                                u1 = d1[i]; u2 = d2[i];
                   1076:                                if ( (u1&0xff000000) < (u2&0xff000000) ) return 0;
                   1077:                                if ( (u1&0xff0000) < (u2&0xff0000) ) return 0;
                   1078:                                if ( (u1&0xff00) < (u2&0xff00) ) return 0;
                   1079:                                if ( (u1&0xff) < (u2&0xff) ) return 0;
                   1080:                        }
                   1081:                        return 1;
                   1082:                        break;
                   1083:                case 16:
                   1084:                        for ( i = 0; i < nd_wpd; i++ ) {
                   1085:                                u1 = d1[i]; u2 = d2[i];
                   1086:                                if ( (u1&0xffff0000) < (u2&0xffff0000) ) return 0;
                   1087:                                if ( (u1&0xffff) < (u2&0xffff) ) return 0;
                   1088:                        }
                   1089:                        return 1;
                   1090:                        break;
                   1091:                case 32:
                   1092:                        for ( i = 0; i < nd_wpd; i++ )
                   1093:                                if ( d1[i] < d2[i] ) return 0;
                   1094:                        return 1;
                   1095:                        break;
                   1096:                default:
1.12      noro     1097:                        for ( i = 0; i < nd_wpd; i++ ) {
                   1098:                                u1 = d1[i]; u2 = d2[i];
                   1099:                                for ( j = 0; j < nd_epw; j++ )
                   1100:                                        if ( (u1&nd_mask[j]) < (u2&nd_mask[j]) ) return 0;
                   1101:                        }
                   1102:                        return 1;
1.11      noro     1103:        }
                   1104: }
                   1105:
1.12      noro     1106: void ndl_lcm(unsigned int *d1,unsigned *d2,unsigned int *d)
1.11      noro     1107: {
                   1108:        unsigned int t1,t2,u,u1,u2;
1.12      noro     1109:        int i,j;
1.11      noro     1110:
                   1111:        switch ( nd_bpe ) {
                   1112:                case 4:
                   1113:                        for ( i = 0; i < nd_wpd; i++ ) {
                   1114:                                u1 = d1[i]; u2 = d2[i];
                   1115:                                t1 = (u1&0xf0000000); t2 = (u2&0xf0000000); u = t1>t2?t1:t2;
                   1116:                                t1 = (u1&0xf000000); t2 = (u2&0xf000000); u |= t1>t2?t1:t2;
                   1117:                                t1 = (u1&0xf00000); t2 = (u2&0xf00000); u |= t1>t2?t1:t2;
                   1118:                                t1 = (u1&0xf0000); t2 = (u2&0xf0000); u |= t1>t2?t1:t2;
                   1119:                                t1 = (u1&0xf000); t2 = (u2&0xf000); u |= t1>t2?t1:t2;
                   1120:                                t1 = (u1&0xf00); t2 = (u2&0xf00); u |= t1>t2?t1:t2;
                   1121:                                t1 = (u1&0xf0); t2 = (u2&0xf0); u |= t1>t2?t1:t2;
                   1122:                                t1 = (u1&0xf); t2 = (u2&0xf); u |= t1>t2?t1:t2;
                   1123:                                d[i] = u;
                   1124:                        }
                   1125:                        break;
1.13    ! noro     1126:                case 6:
        !          1127:                        for ( i = 0; i < nd_wpd; i++ ) {
        !          1128:                                u1 = d1[i]; u2 = d2[i];
        !          1129:                                t1 = (u1&0x3f000000); t2 = (u2&0x3f000000); u = t1>t2?t1:t2;
        !          1130:                                t1 = (u1&0xfc0000); t2 = (u2&0xfc0000); u |= t1>t2?t1:t2;
        !          1131:                                t1 = (u1&0x3f000); t2 = (u2&0x3f000); u |= t1>t2?t1:t2;
        !          1132:                                t1 = (u1&0xfc0); t2 = (u2&0xfc0); u |= t1>t2?t1:t2;
        !          1133:                                t1 = (u1&0x3f); t2 = (u2&0x3f); u |= t1>t2?t1:t2;
        !          1134:                                d[i] = u;
        !          1135:                        }
        !          1136:                        break;
1.11      noro     1137:                case 8:
                   1138:                        for ( i = 0; i < nd_wpd; i++ ) {
                   1139:                                u1 = d1[i]; u2 = d2[i];
                   1140:                                t1 = (u1&0xff000000); t2 = (u2&0xff000000); u = t1>t2?t1:t2;
                   1141:                                t1 = (u1&0xff0000); t2 = (u2&0xff0000); u |= t1>t2?t1:t2;
                   1142:                                t1 = (u1&0xff00); t2 = (u2&0xff00); u |= t1>t2?t1:t2;
                   1143:                                t1 = (u1&0xff); t2 = (u2&0xff); u |= t1>t2?t1:t2;
                   1144:                                d[i] = u;
                   1145:                        }
                   1146:                        break;
                   1147:                case 16:
                   1148:                        for ( i = 0; i < nd_wpd; i++ ) {
                   1149:                                u1 = d1[i]; u2 = d2[i];
                   1150:                                t1 = (u1&0xffff0000); t2 = (u2&0xffff0000); u = t1>t2?t1:t2;
                   1151:                                t1 = (u1&0xffff); t2 = (u2&0xffff); u |= t1>t2?t1:t2;
                   1152:                                d[i] = u;
                   1153:                        }
                   1154:                        break;
                   1155:                case 32:
                   1156:                        for ( i = 0; i < nd_wpd; i++ ) {
                   1157:                                u1 = d1[i]; u2 = d2[i];
                   1158:                                d[i] = u1>u2?u1:u2;
                   1159:                        }
                   1160:                        break;
                   1161:                default:
1.12      noro     1162:                        for ( i = 0; i < nd_wpd; i++ ) {
                   1163:                                u1 = d1[i]; u2 = d2[i];
                   1164:                                for ( j = 0, u = 0; j < nd_epw; j++ ) {
                   1165:                                        t1 = (u1&nd_mask[j]); t2 = (u2&nd_mask[j]); u |= t1>t2?t1:t2;
                   1166:                                }
                   1167:                                d[i] = u;
                   1168:                        }
                   1169:                        break;
1.11      noro     1170:        }
                   1171: }
                   1172:
1.12      noro     1173: int ndl_td(unsigned int *d)
1.11      noro     1174: {
                   1175:        unsigned int t,u;
1.12      noro     1176:        int i,j;
1.11      noro     1177:
1.12      noro     1178:        for ( t = 0, i = 0; i < nd_wpd; i++ ) {
                   1179:                u = d[i];
                   1180:                for ( j = 0; j < nd_epw; j++, u>>=nd_bpe )
                   1181:                        t += (u&nd_mask0);
1.11      noro     1182:        }
                   1183:        return t;
                   1184: }
                   1185:
                   1186: INLINE int ndl_compare(unsigned int *d1,unsigned int *d2)
                   1187: {
                   1188:        int i;
                   1189:
1.12      noro     1190:        for ( i = 0; i < nd_wpd; i++, d1++, d2++ )
                   1191:                if ( *d1 > *d2 )
1.11      noro     1192:                        return is_rlex ? -1 : 1;
1.12      noro     1193:                else if ( *d1 < *d2 )
1.11      noro     1194:                        return is_rlex ? 1 : -1;
                   1195:        return 0;
                   1196: }
                   1197:
                   1198: INLINE int ndl_equal(unsigned int *d1,unsigned int *d2)
                   1199: {
                   1200:        int i;
                   1201:
                   1202:        for ( i = 0; i < nd_wpd; i++ )
                   1203:                if ( d1[i] != d2[i] )
                   1204:                        return 0;
                   1205:        return 1;
                   1206: }
                   1207:
                   1208: INLINE void ndl_add(unsigned int *d1,unsigned int *d2,unsigned int *d)
                   1209: {
                   1210:        int i;
                   1211:
                   1212:        for ( i = 0; i < nd_wpd; i++ )
                   1213:                d[i] = d1[i]+d2[i];
                   1214: }
                   1215:
1.12      noro     1216: void ndl_sub(unsigned int *d1,unsigned int *d2,unsigned int *d)
1.11      noro     1217: {
                   1218:        int i;
                   1219:
                   1220:        for ( i = 0; i < nd_wpd; i++ )
                   1221:                d[i] = d1[i]-d2[i];
                   1222: }
                   1223:
1.12      noro     1224: int ndl_disjoint(unsigned int *d1,unsigned int *d2)
1.11      noro     1225: {
                   1226:        unsigned int t1,t2,u,u1,u2;
1.12      noro     1227:        int i,j;
1.11      noro     1228:
                   1229:        switch ( nd_bpe ) {
                   1230:                case 4:
                   1231:                        for ( i = 0; i < nd_wpd; i++ ) {
                   1232:                                u1 = d1[i]; u2 = d2[i];
                   1233:                                t1 = u1&0xf0000000; t2 = u2&0xf0000000; if ( t1&&t2 ) return 0;
                   1234:                                t1 = u1&0xf000000; t2 = u2&0xf000000; if ( t1&&t2 ) return 0;
                   1235:                                t1 = u1&0xf00000; t2 = u2&0xf00000; if ( t1&&t2 ) return 0;
                   1236:                                t1 = u1&0xf0000; t2 = u2&0xf0000; if ( t1&&t2 ) return 0;
                   1237:                                t1 = u1&0xf000; t2 = u2&0xf000; if ( t1&&t2 ) return 0;
                   1238:                                t1 = u1&0xf00; t2 = u2&0xf00; if ( t1&&t2 ) return 0;
                   1239:                                t1 = u1&0xf0; t2 = u2&0xf0; if ( t1&&t2 ) return 0;
                   1240:                                t1 = u1&0xf; t2 = u2&0xf; if ( t1&&t2 ) return 0;
                   1241:                        }
                   1242:                        return 1;
                   1243:                        break;
1.13    ! noro     1244:                case 6:
        !          1245:                        for ( i = 0; i < nd_wpd; i++ ) {
        !          1246:                                u1 = d1[i]; u2 = d2[i];
        !          1247:                                t1 = u1&0x3f000000; t2 = u2&0x3f000000; if ( t1&&t2 ) return 0;
        !          1248:                                t1 = u1&0xfc0000; t2 = u2&0xfc0000; if ( t1&&t2 ) return 0;
        !          1249:                                t1 = u1&0x3f000; t2 = u2&0x3f000; if ( t1&&t2 ) return 0;
        !          1250:                                t1 = u1&0xfc0; t2 = u2&0xfc0; if ( t1&&t2 ) return 0;
        !          1251:                                t1 = u1&0x3f; t2 = u2&0x3f; if ( t1&&t2 ) return 0;
        !          1252:                        }
        !          1253:                        return 1;
        !          1254:                        break;
1.11      noro     1255:                case 8:
                   1256:                        for ( i = 0; i < nd_wpd; i++ ) {
                   1257:                                u1 = d1[i]; u2 = d2[i];
                   1258:                                t1 = u1&0xff000000; t2 = u2&0xff000000; if ( t1&&t2 ) return 0;
                   1259:                                t1 = u1&0xff0000; t2 = u2&0xff0000; if ( t1&&t2 ) return 0;
                   1260:                                t1 = u1&0xff00; t2 = u2&0xff00; if ( t1&&t2 ) return 0;
                   1261:                                t1 = u1&0xff; t2 = u2&0xff; if ( t1&&t2 ) return 0;
                   1262:                        }
                   1263:                        return 1;
                   1264:                        break;
                   1265:                case 16:
                   1266:                        for ( i = 0; i < nd_wpd; i++ ) {
                   1267:                                u1 = d1[i]; u2 = d2[i];
                   1268:                                t1 = u1&0xffff0000; t2 = u2&0xffff0000; if ( t1&&t2 ) return 0;
                   1269:                                t1 = u1&0xffff; t2 = u2&0xffff; if ( t1&&t2 ) return 0;
                   1270:                        }
                   1271:                        return 1;
                   1272:                        break;
                   1273:                case 32:
                   1274:                        for ( i = 0; i < nd_wpd; i++ )
                   1275:                                if ( d1[i] && d2[i] ) return 0;
                   1276:                        return 1;
                   1277:                        break;
                   1278:                default:
1.12      noro     1279:                        for ( i = 0; i < nd_wpd; i++ ) {
                   1280:                                u1 = d1[i]; u2 = d2[i];
                   1281:                                for ( j = 0; j < nd_epw; j++ ) {
                   1282:                                        if ( (u1&nd_mask0) && (u2&nd_mask0) ) return 0;
                   1283:                                        u1 >>= nd_bpe; u2 >>= nd_bpe;
                   1284:                                }
1.11      noro     1285:                        }
1.12      noro     1286:                        return 1;
                   1287:                        break;
1.11      noro     1288:        }
                   1289: }
                   1290:
                   1291: ND nd_reduce(ND p1,ND p2)
                   1292: {
1.13    ! noro     1293:        int c,c1,c2,t,td,td2,mul;
1.11      noro     1294:        NM m2,prev,head,cur,new;
                   1295:        unsigned int *d;
                   1296:
                   1297:        if ( !p1 )
                   1298:                return 0;
                   1299:        else {
1.13    ! noro     1300:                c2 = invm(HC(p2),nd_mod);
        !          1301:                c1 = nd_mod-HC(p1);
        !          1302:                DMAR(c1,c2,0,nd_mod,mul);
1.11      noro     1303:                td = HTD(p1)-HTD(p2);
                   1304:                d = (unsigned int *)ALLOCA(nd_wpd*sizeof(unsigned int));
                   1305:                ndl_sub(HDL(p1),HDL(p2),d);
                   1306:                prev = 0; head = cur = BDY(p1);
                   1307:                NEWNM(new);
                   1308:                for ( m2 = BDY(p2); m2; ) {
                   1309:                        td2 = new->td = m2->td+td;
                   1310:                        ndl_add(m2->dl,d,new->dl);
                   1311:                        if ( !cur ) {
1.13    ! noro     1312:                                c1 = C(m2);
        !          1313:                                DMAR(c1,mul,0,nd_mod,c2);
        !          1314:                                C(new) = c2;
1.11      noro     1315:                                if ( !prev ) {
                   1316:                                        prev = new;
                   1317:                                        NEXT(prev) = 0;
                   1318:                                        head = prev;
                   1319:                                } else {
                   1320:                                        NEXT(prev) = new;
                   1321:                                        NEXT(new) = 0;
                   1322:                                        prev = new;
                   1323:                                }
                   1324:                                m2 = NEXT(m2);
                   1325:                                NEWNM(new);
                   1326:                                continue;
                   1327:                        }
                   1328:                        if ( cur->td > td2 )
                   1329:                                c = 1;
                   1330:                        else if ( cur->td < td2 )
                   1331:                                c = -1;
                   1332:                        else
                   1333:                                c = ndl_compare(cur->dl,new->dl);
                   1334:                        switch ( c ) {
                   1335:                                case 0:
1.13    ! noro     1336:                                        c2 = C(m2);
        !          1337:                                        c1 = C(cur);
        !          1338:                                        DMAR(c2,mul,c1,nd_mod,t);
1.11      noro     1339:                                        if ( t )
                   1340:                                                C(cur) = t;
                   1341:                                        else if ( !prev ) {
                   1342:                                                head = NEXT(cur);
                   1343:                                                FREENM(cur);
                   1344:                                                cur = head;
                   1345:                                        } else {
                   1346:                                                NEXT(prev) = NEXT(cur);
                   1347:                                                FREENM(cur);
                   1348:                                                cur = NEXT(prev);
                   1349:                                        }
                   1350:                                        m2 = NEXT(m2);
                   1351:                                        break;
                   1352:                                case 1:
                   1353:                                        prev = cur;
                   1354:                                        cur = NEXT(cur);
                   1355:                                        break;
                   1356:                                case -1:
                   1357:                                        if ( !prev ) {
                   1358:                                                /* cur = head */
                   1359:                                                prev = new;
1.13    ! noro     1360:                                                c2 = C(m2);
        !          1361:                                                DMAR(c2,mul,0,nd_mod,c1);
        !          1362:                                                C(prev) = c1;
1.11      noro     1363:                                                NEXT(prev) = head;
                   1364:                                                head = prev;
                   1365:                                        } else {
1.13    ! noro     1366:                                                c2 = C(m2);
        !          1367:                                                DMAR(c2,mul,0,nd_mod,c1);
        !          1368:                                                C(new) = c1;
1.11      noro     1369:                                                NEXT(prev) = new;
                   1370:                                                NEXT(new) = cur;
                   1371:                                                prev = new;
                   1372:                                        }
                   1373:                                        NEWNM(new);
                   1374:                                        m2 = NEXT(m2);
                   1375:                                        break;
                   1376:                        }
                   1377:                }
                   1378:                FREENM(new);
                   1379:                if ( head ) {
                   1380:                        BDY(p1) = head;
                   1381:                        p1->sugar = MAX(p1->sugar,p2->sugar+td);
                   1382:                        return p1;
                   1383:                } else {
                   1384:                        FREEND(p1);
                   1385:                        return 0;
                   1386:                }
                   1387:
                   1388:        }
                   1389: }
                   1390:
                   1391: ND nd_sp(ND_pairs p)
                   1392: {
                   1393:        NM m;
                   1394:        ND p1,p2,t1,t2;
                   1395:        unsigned int *lcm;
                   1396:        int td;
                   1397:
                   1398:        p1 = nps[p->i1];
                   1399:        p2 = nps[p->i2];
                   1400:        lcm = p->lcm;
                   1401:        td = p->td;
                   1402:        NEWNM(m);
                   1403:        C(m) = HC(p2); m->td = td-HTD(p1); ndl_sub(lcm,HDL(p1),m->dl); NEXT(m) = 0;
                   1404:        t1 = nd_mul_nm(p1,m);
                   1405:        C(m) = nd_mod-HC(p1); m->td = td-HTD(p2); ndl_sub(lcm,HDL(p2),m->dl);
                   1406:        t2 = nd_mul_nm(p2,m);
                   1407:        FREENM(m);
                   1408:        return nd_add(t1,t2);
                   1409: }
                   1410:
1.12      noro     1411: ND nd_find_reducer(ND g)
                   1412: {
                   1413:        NM m;
                   1414:        ND r,p;
1.13    ! noro     1415:        int i,c1,c2,c;
1.12      noro     1416:
                   1417:        for ( i = 0; i < nd_psn; i++ ) {
                   1418:                p = nps[i];
                   1419:                if ( HTD(g) >= HTD(p) && ndl_reducible(HDL(g),HDL(p)) ) {
1.11      noro     1420: #if 1
1.12      noro     1421:                        NEWNM(m);
1.13    ! noro     1422:                        c1 = invm(HC(p),nd_mod);
        !          1423:                        c2 = nd_mod-HC(g);
        !          1424:                        DMAR(c1,c2,0,nd_mod,c);
        !          1425:                        C(m) = c;
1.12      noro     1426:                        m->td = HTD(g)-HTD(p);
                   1427:                        ndl_sub(HDL(g),HDL(p),m->dl);
                   1428:                        NEXT(m) = 0;
                   1429:                        r = nd_mul_nm(p,m);
                   1430:                        FREENM(m);
                   1431:                        r->sugar = m->td + p->sugar;
                   1432:                        return r;
                   1433: #else
                   1434:                        return p;
                   1435: #endif
                   1436:                }
                   1437:        }
                   1438:        return 0;
                   1439: }
                   1440:
1.13    ! noro     1441: ND nd_find_monic_reducer(ND g)
        !          1442: {
        !          1443:        int *d;
        !          1444:        ND p,r;
        !          1445:        int i;
        !          1446:
        !          1447:        for ( i = 0; i < nd_psn; i++ ) {
        !          1448:                p = nps[i];
        !          1449:                if ( HTD(g) >= HTD(p) && ndl_reducible(HDL(g),HDL(p)) ) {
        !          1450:                        d = (int *)ALLOCA(nd_wpd*sizeof(int));
        !          1451:                        ndl_sub(HDL(g),HDL(p),d);
        !          1452:                        r = nd_mul_term(p,HTD(g)-HTD(p),d);
        !          1453:                        return r;
        !          1454:                }
        !          1455:        }
        !          1456:        return 0;
        !          1457: }
        !          1458:
1.12      noro     1459: ND nd_add(ND p1,ND p2)
1.11      noro     1460: {
1.12      noro     1461:        int n,c;
                   1462:        int t;
                   1463:        ND r;
                   1464:        NM m1,m2,mr0,mr,s;
                   1465:
                   1466:        if ( !p1 )
                   1467:                return p2;
                   1468:        else if ( !p2 )
                   1469:                return p1;
                   1470:        else {
                   1471:                for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
                   1472:                        if ( m1->td > m2->td )
                   1473:                                c = 1;
                   1474:                        else if ( m1->td < m2->td )
                   1475:                                c = -1;
                   1476:                        else
                   1477:                                c = ndl_compare(m1->dl,m2->dl);
                   1478:                        switch ( c ) {
                   1479:                                case 0:
                   1480:                                        t = ((C(m1))+(C(m2))) - nd_mod;
                   1481:                                        if ( t < 0 )
                   1482:                                                t += nd_mod;
                   1483:                                        s = m1; m1 = NEXT(m1);
                   1484:                                        if ( t ) {
                   1485:                                                NEXTNM2(mr0,mr,s); C(mr) = (t);
                   1486:                                        } else {
                   1487:                                                FREENM(s);
                   1488:                                        }
                   1489:                                        s = m2; m2 = NEXT(m2); FREENM(s);
                   1490:                                        break;
                   1491:                                case 1:
                   1492:                                        s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
                   1493:                                        break;
                   1494:                                case -1:
                   1495:                                        s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
                   1496:                                        break;
                   1497:                        }
                   1498:                }
                   1499:                if ( !mr0 )
                   1500:                        if ( m1 )
                   1501:                                mr0 = m1;
                   1502:                        else if ( m2 )
                   1503:                                mr0 = m2;
                   1504:                        else
                   1505:                                return 0;
                   1506:                else if ( m1 )
                   1507:                        NEXT(mr) = m1;
                   1508:                else if ( m2 )
                   1509:                        NEXT(mr) = m2;
                   1510:                else
                   1511:                        NEXT(mr) = 0;
                   1512:                BDY(p1) = mr0;
                   1513:                p1->sugar = MAX(p1->sugar,p2->sugar);
                   1514:                FREEND(p2);
                   1515:                return p1;
                   1516:        }
                   1517: }
                   1518:
                   1519: ND nd_mul_nm(ND p,NM m0)
                   1520: {
                   1521:        NM m,mr,mr0;
                   1522:        unsigned int *d,*dt,*dm;
1.13    ! noro     1523:        int c,n,td,i,c1,c2;
1.12      noro     1524:        int *pt,*p1,*p2;
                   1525:        ND r;
1.11      noro     1526:
1.12      noro     1527:        if ( !p )
1.11      noro     1528:                return 0;
1.12      noro     1529:        else {
                   1530:                n = NV(p); m = BDY(p);
                   1531:                d = m0->dl; td = m0->td; c = C(m0);
                   1532:                mr0 = 0;
                   1533:                for ( ; m; m = NEXT(m) ) {
                   1534:                        NEXTNM(mr0,mr);
1.13    ! noro     1535:                        c1 = C(m);
        !          1536:                        DMAR(c1,c,0,nd_mod,c2);
        !          1537:                        C(mr) = c2;
        !          1538:                        mr->td = m->td+td;
        !          1539:                        ndl_add(m->dl,d,mr->dl);
        !          1540:                }
        !          1541:                NEXT(mr) = 0;
        !          1542:                MKND(NV(p),mr0,r);
        !          1543:                r->sugar = p->sugar + td;
        !          1544:                return r;
        !          1545:        }
        !          1546: }
        !          1547:
        !          1548: ND nd_mul_term(ND p,int td,unsigned int *d)
        !          1549: {
        !          1550:        NM m,mr,mr0;
        !          1551:        int c,n;
        !          1552:        ND r;
        !          1553:
        !          1554:        if ( !p )
        !          1555:                return 0;
        !          1556:        else {
        !          1557:                n = NV(p); m = BDY(p);
        !          1558:                mr0 = 0;
        !          1559:                for ( ; m; m = NEXT(m) ) {
        !          1560:                        NEXTNM(mr0,mr);
        !          1561:                        C(mr) = C(m);
1.12      noro     1562:                        mr->td = m->td+td;
                   1563:                        ndl_add(m->dl,d,mr->dl);
                   1564:                }
                   1565:                NEXT(mr) = 0;
                   1566:                MKND(NV(p),mr0,r);
                   1567:                r->sugar = p->sugar + td;
                   1568:                return r;
1.11      noro     1569:        }
1.12      noro     1570: }
                   1571:
                   1572: #if 1
                   1573: ND nd_nf(ND g,int full)
                   1574: {
                   1575:        ND p,d,red;
                   1576:        NM m,mrd,tail;
                   1577:        int n,sugar,psugar;
                   1578:
                   1579:        if ( !g )
                   1580:                return 0;
1.11      noro     1581:        sugar = g->sugar;
1.12      noro     1582:        n = NV(g);
1.11      noro     1583:        for ( d = 0; g; ) {
1.12      noro     1584:                red = nd_find_reducer(g);
                   1585:                if ( red ) {
                   1586: #if 1
                   1587:                        g = nd_add(g,red);
                   1588:                        sugar = MAX(sugar,red->sugar);
1.11      noro     1589: #else
1.12      noro     1590:                        psugar = (HTD(g)-HTD(red))+red->sugar;
                   1591:                        g = nd_reduce(g,red);
                   1592:                        sugar = MAX(sugar,psugar);
1.11      noro     1593: #endif
1.12      noro     1594:                } else if ( !full )
                   1595:                        return g;
                   1596:                else {
                   1597:                        m = BDY(g);
                   1598:                        if ( NEXT(m) ) {
                   1599:                                BDY(g) = NEXT(m); NEXT(m) = 0;
                   1600:                        } else {
                   1601:                                FREEND(g); g = 0;
1.11      noro     1602:                        }
1.12      noro     1603:                        if ( d ) {
                   1604:                                NEXT(tail)=m;
                   1605:                                tail=m;
1.11      noro     1606:                        } else {
1.12      noro     1607:                                MKND(n,m,d);
                   1608:                                tail = BDY(d);
1.11      noro     1609:                        }
                   1610:                }
                   1611:        }
                   1612:        if ( d )
                   1613:                d->sugar = sugar;
                   1614:        return d;
                   1615: }
                   1616: #else
                   1617:
                   1618: ND nd_remove_head(ND p)
                   1619: {
                   1620:        NM m;
                   1621:
                   1622:        m = BDY(p);
                   1623:        if ( !NEXT(m) ) {
                   1624:                FREEND(p);
                   1625:                p = 0;
                   1626:        } else
                   1627:                BDY(p) = NEXT(m);
                   1628:        FREENM(m);
                   1629:        return p;
                   1630: }
                   1631:
                   1632: PGeoBucket create_pbucket()
                   1633: {
                   1634:     PGeoBucket g;
                   1635:
                   1636:        g = CALLOC(1,sizeof(struct oPGeoBucket));
                   1637:        g->m = -1;
                   1638:        return g;
                   1639: }
                   1640:
                   1641: void add_pbucket(PGeoBucket g,ND d)
                   1642: {
                   1643:        int l,k,m;
                   1644:
                   1645:        l = nd_length(d);
                   1646:        for ( k = 0, m = 1; l > m; k++, m <<= 2 );
                   1647:        /* 4^(k-1) < l <= 4^k */
                   1648:        d = nd_add(g->body[k],d);
                   1649:        for ( ; d && nd_length(d) > 1<<(2*k); k++ ) {
                   1650:                g->body[k] = 0;
                   1651:                d = nd_add(g->body[k+1],d);
                   1652:        }
                   1653:        g->body[k] = d;
                   1654:        g->m = MAX(g->m,k);
                   1655: }
                   1656:
                   1657: int head_pbucket(PGeoBucket g)
                   1658: {
                   1659:        int j,i,c,k,nv,sum;
                   1660:        unsigned int *di,*dj;
                   1661:        ND gi,gj;
                   1662:
                   1663:        k = g->m;
                   1664:        while ( 1 ) {
                   1665:                j = -1;
                   1666:                for ( i = 0; i <= k; i++ ) {
                   1667:                        if ( !(gi = g->body[i]) )
                   1668:                                continue;
                   1669:                        if ( j < 0 ) {
                   1670:                                j = i;
                   1671:                                gj = g->body[j];
                   1672:                                dj = HDL(gj);
                   1673:                                sum = HC(gj);
                   1674:                        } else {
                   1675:                                di = HDL(gi);
                   1676:                                nv = NV(gi);
                   1677:                                if ( HTD(gi) > HTD(gj) )
                   1678:                                        c = 1;
                   1679:                                else if ( HTD(gi) < HTD(gj) )
                   1680:                                        c = -1;
                   1681:                                else
                   1682:                                        c = ndl_compare(di,dj);
                   1683:                                if ( c > 0 ) {
                   1684:                                        if ( sum )
                   1685:                                                HC(gj) = sum;
                   1686:                                        else
                   1687:                                                g->body[j] = nd_remove_head(gj);
                   1688:                                        j = i;
                   1689:                                        gj = g->body[j];
                   1690:                                        dj = HDL(gj);
                   1691:                                        sum = HC(gj);
                   1692:                                } else if ( c == 0 ) {
                   1693:                                        sum = sum+HC(gi)-nd_mod;
                   1694:                                        if ( sum < 0 )
                   1695:                                                sum += nd_mod;
                   1696:                                        g->body[i] = nd_remove_head(gi);
                   1697:                                }
                   1698:                        }
                   1699:                }
                   1700:                if ( j < 0 )
                   1701:                        return -1;
                   1702:                else if ( sum ) {
                   1703:                        HC(gj) = sum;
                   1704:                        return j;
                   1705:                } else
                   1706:                        g->body[j] = nd_remove_head(gj);
                   1707:        }
                   1708: }
                   1709:
                   1710: ND normalize_pbucket(PGeoBucket g)
                   1711: {
                   1712:        int i;
                   1713:        ND r,t;
                   1714:
                   1715:        r = 0;
                   1716:        for ( i = 0; i <= g->m; i++ )
                   1717:                r = nd_add(r,g->body[i]);
                   1718:        return r;
                   1719: }
                   1720:
1.12      noro     1721: ND nd_nf(ND g,int full)
1.11      noro     1722: {
                   1723:        ND u,p,d,red;
                   1724:        NODE l;
                   1725:        NM m,mrd;
                   1726:        int sugar,psugar,n,h_reducible,h;
                   1727:        PGeoBucket bucket;
                   1728:
                   1729:        if ( !g ) {
                   1730:                return 0;
                   1731:        }
                   1732:        sugar = g->sugar;
                   1733:        n = g->nv;
                   1734:        bucket = create_pbucket();
                   1735:        add_pbucket(bucket,g);
                   1736:        d = 0;
                   1737:        while ( 1 ) {
                   1738:                h = head_pbucket(bucket);
                   1739:                if ( h < 0 ) {
                   1740:                        if ( d )
                   1741:                                d->sugar = sugar;
                   1742:                        return d;
                   1743:                }
                   1744:                g = bucket->body[h];
1.12      noro     1745:                red = nd_find_reducer(g);
                   1746:                if ( red ) {
                   1747:                        bucket->body[h] = nd_remove_head(g);
                   1748:                        red = nd_remove_head(red);
                   1749:                        add_pbucket(bucket,red);
                   1750:                        sugar = MAX(sugar,red->sugar);
                   1751:                } else if ( !full ) {
                   1752:                        g = normalize_pbucket(bucket);
                   1753:                        if ( g )
                   1754:                                g->sugar = sugar;
                   1755:                        return g;
                   1756:                } else {
                   1757:                        m = BDY(g);
                   1758:                        if ( NEXT(m) ) {
                   1759:                                BDY(g) = NEXT(m); NEXT(m) = 0;
                   1760:                        } else {
                   1761:                                FREEND(g); g = 0;
1.11      noro     1762:                        }
1.12      noro     1763:                        bucket->body[h] = g;
                   1764:                        NEXT(m) = 0;
                   1765:                        if ( d ) {
                   1766:                                for ( mrd = BDY(d); NEXT(mrd); mrd = NEXT(mrd) );
                   1767:                                NEXT(mrd) = m;
1.11      noro     1768:                        } else {
1.12      noro     1769:                                MKND(n,m,d);
1.11      noro     1770:                        }
                   1771:                }
                   1772:        }
                   1773: }
                   1774: #endif
                   1775:
                   1776: NODE nd_gb(NODE f)
                   1777: {
                   1778:        int i,nh;
                   1779:        NODE r,g,gall;
                   1780:        ND_pairs d;
                   1781:        ND_pairs l;
                   1782:        ND h,nf;
                   1783:
                   1784:        for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
                   1785:                i = (int)BDY(r);
                   1786:                d = update_pairs(d,g,i);
                   1787:                g = update_base(g,i);
                   1788:                gall = append_one(gall,i);
                   1789:        }
                   1790:        while ( d ) {
                   1791: #if 0
                   1792:                ndp_print(d);
                   1793: #endif
                   1794:                l = nd_minp(d,&d);
                   1795:                h = nd_sp(l);
1.12      noro     1796:                nf = nd_nf(h,!Top);
1.11      noro     1797:                if ( nf ) {
                   1798:                        printf("+"); fflush(stdout);
                   1799: #if 0
                   1800:                        ndl_print(HDL(nf)); fflush(stdout);
                   1801: #endif
                   1802:                        nh = nd_newps(nf);
                   1803:                        d = update_pairs(d,g,nh);
                   1804:                        g = update_base(g,nh);
                   1805:                        gall = append_one(gall,nh);
                   1806:                } else {
                   1807:                        printf("."); fflush(stdout);
                   1808:                }
                   1809:        }
                   1810:        return g;
                   1811: }
                   1812:
                   1813: ND_pairs update_pairs( ND_pairs d, NODE /* of index */ g, int t)
                   1814: {
                   1815:        ND_pairs d1,nd,cur,head,prev;
                   1816:
                   1817:        if ( !g ) return d;
                   1818:        d = crit_B(d,t);
                   1819:        d1 = nd_newpairs(g,t);
                   1820:        d1 = crit_M(d1);
                   1821:        d1 = crit_F(d1);
                   1822:        prev = 0; cur = head = d1;
                   1823:        while ( cur ) {
                   1824:                if ( crit_2( cur->i1,cur->i2 ) ) {
                   1825:                        if ( !prev ) {
                   1826:                                head = cur = NEXT(cur);
                   1827:                        } else {
                   1828:                                cur = NEXT(prev) = NEXT(cur);
                   1829:                        }
                   1830:                } else {
                   1831:                        prev = cur;
                   1832:                        cur = NEXT(cur);
                   1833:                }
                   1834:        }
                   1835:        if ( !d )
                   1836:                return head;
                   1837:        else {
                   1838:                nd = d;
                   1839:                while ( NEXT(nd) )
                   1840:                        nd = NEXT(nd);
                   1841:                NEXT(nd) = head;
                   1842:                return d;
                   1843:        }
                   1844: }
                   1845:
                   1846: ND_pairs nd_newpairs( NODE g, int t )
                   1847: {
                   1848:        NODE h;
                   1849:        unsigned int *dl;
                   1850:        int td,ts,s;
                   1851:        ND_pairs r,r0;
                   1852:
                   1853:        dl = HDL(nps[t]);
                   1854:        td = HTD(nps[t]);
                   1855:        ts = nps[t]->sugar - td;
                   1856:        for ( r0 = 0, h = g; h; h = NEXT(h) ) {
                   1857:                NEXTND_pairs(r0,r);
                   1858:                r->i1 = (int)BDY(h);
                   1859:                r->i2 = t;
                   1860:                ndl_lcm(HDL(nps[r->i1]),dl,r->lcm);
                   1861:                r->td = ndl_td(r->lcm);
                   1862:                s = nps[r->i1]->sugar-HTD(nps[r->i1]);
                   1863:                r->sugar = MAX(s,ts) + r->td;
                   1864:        }
                   1865:        NEXT(r) = 0;
                   1866:        return r0;
                   1867: }
                   1868:
                   1869: ND_pairs crit_B( ND_pairs d, int s )
                   1870: {
                   1871:        ND_pairs cur,head,prev;
                   1872:        unsigned int *t,*tl,*lcm;
                   1873:        int td,tdl;
                   1874:
                   1875:        if ( !d ) return 0;
                   1876:        t = HDL(nps[s]);
                   1877:        prev = 0;
                   1878:        head = cur = d;
                   1879:        lcm = (unsigned int *)ALLOCA(nd_wpd*sizeof(unsigned int));
                   1880:        while ( cur ) {
                   1881:                tl = cur->lcm;
                   1882:                if ( ndl_reducible(tl,t)
                   1883:                        && (ndl_lcm(HDL(nps[cur->i1]),t,lcm),!ndl_equal(lcm,tl))
                   1884:                        && (ndl_lcm(HDL(nps[cur->i2]),t,lcm),!ndl_equal(lcm,tl)) ) {
                   1885:                        if ( !prev ) {
                   1886:                                head = cur = NEXT(cur);
                   1887:                        } else {
                   1888:                                cur = NEXT(prev) = NEXT(cur);
                   1889:                        }
                   1890:                } else {
                   1891:                        prev = cur;
                   1892:                        cur = NEXT(cur);
                   1893:                }
                   1894:        }
                   1895:        return head;
                   1896: }
                   1897:
                   1898: ND_pairs crit_M( ND_pairs d1 )
                   1899: {
                   1900:        ND_pairs e,d2,d3,dd,p;
                   1901:        unsigned int *id,*jd;
                   1902:        int itd,jtd;
                   1903:
                   1904:        for ( dd = 0, e = d1; e; e = d3 ) {
                   1905:                if ( !(d2 = NEXT(e)) ) {
                   1906:                        NEXT(e) = dd;
                   1907:                        return e;
                   1908:                }
                   1909:                id = e->lcm;
                   1910:                itd = e->td;
                   1911:                for ( d3 = 0; d2; d2 = p ) {
                   1912:                        p = NEXT(d2),
                   1913:                        jd = d2->lcm;
                   1914:                        jtd = d2->td;
                   1915:                        if ( jtd == itd  )
                   1916:                                if ( id == jd );
                   1917:                                else if ( ndl_reducible(jd,id) ) continue;
                   1918:                                else if ( ndl_reducible(id,jd) ) goto delit;
                   1919:                                else ;
                   1920:                        else if ( jtd > itd )
                   1921:                                if ( ndl_reducible(jd,id) ) continue;
                   1922:                                else ;
                   1923:                        else if ( ndl_reducible(id,jd ) ) goto delit;
                   1924:                        NEXT(d2) = d3;
                   1925:                        d3 = d2;
                   1926:                }
                   1927:                NEXT(e) = dd;
                   1928:                dd = e;
                   1929:                continue;
                   1930:                /**/
                   1931:        delit:  NEXT(d2) = d3;
                   1932:                d3 = d2;
                   1933:                for ( ; p; p = d2 ) {
                   1934:                        d2 = NEXT(p);
                   1935:                        NEXT(p) = d3;
                   1936:                        d3 = p;
                   1937:                }
                   1938:        }
                   1939:        return dd;
                   1940: }
                   1941:
                   1942: ND_pairs crit_F( ND_pairs d1 )
                   1943: {
                   1944:        ND_pairs rest, head;
                   1945:        ND_pairs last, p, r, w;
                   1946:        int s;
                   1947:
                   1948:        for ( head = last = 0, p = d1; NEXT(p); ) {
                   1949:                r = w = equivalent_pairs(p,&rest);
                   1950:                s = r->sugar;
                   1951:                while ( w = NEXT(w) )
                   1952:                        if ( crit_2(w->i1,w->i2) ) {
                   1953:                                r = w;
                   1954:                                break;
                   1955:                        } else if ( w->sugar < s ) {
                   1956:                                r = w;
                   1957:                                s = r->sugar;
                   1958:                        }
                   1959:                if ( last ) NEXT(last) = r;
                   1960:                else head = r;
                   1961:                NEXT(last = r) = 0;
                   1962:                p = rest;
                   1963:                if ( !p ) return head;
                   1964:        }
                   1965:        if ( !last ) return p;
                   1966:        NEXT(last) = p;
                   1967:        return head;
                   1968: }
                   1969:
                   1970: int crit_2( int dp1, int dp2 )
                   1971: {
                   1972:        return ndl_disjoint(HDL(nps[dp1]),HDL(nps[dp2]));
                   1973: }
                   1974:
                   1975: static ND_pairs equivalent_pairs( ND_pairs d1, ND_pairs *prest )
                   1976: {
                   1977:        ND_pairs w,p,r,s;
                   1978:        unsigned int *d;
                   1979:        int td;
                   1980:
                   1981:        w = d1;
                   1982:        d = w->lcm;
                   1983:        td = w->td;
                   1984:        s = NEXT(w);
                   1985:        NEXT(w) = 0;
                   1986:        for ( r = 0; s; s = p ) {
                   1987:                p = NEXT(s);
                   1988:                if ( td == s->td && ndl_equal(d,s->lcm) ) {
                   1989:                        NEXT(s) = w;
                   1990:                        w = s;
                   1991:                } else {
                   1992:                        NEXT(s) = r;
                   1993:                        r = s;
                   1994:                }
                   1995:        }
                   1996:        *prest = r;
                   1997:        return w;
                   1998: }
                   1999:
                   2000: NODE update_base(NODE nd,int ndp)
                   2001: {
                   2002:        unsigned int *dl, *dln;
                   2003:        NODE last, p, head;
                   2004:        int td,tdn;
                   2005:
                   2006:        dl = HDL(nps[ndp]);
                   2007:        td = HTD(nps[ndp]);
                   2008:        for ( head = last = 0, p = nd; p; ) {
                   2009:                dln = HDL(nps[(int)BDY(p)]);
                   2010:                tdn = HTD(nps[(int)BDY(p)]);
                   2011:                if ( tdn >= td && ndl_reducible( dln, dl ) ) {
                   2012:                        p = NEXT(p);
                   2013:                        if ( last ) NEXT(last) = p;
                   2014:                } else {
                   2015:                        if ( !last ) head = p;
                   2016:                        p = NEXT(last = p);
                   2017:                }
                   2018:        }
                   2019:        head = append_one(head,ndp);
                   2020:        return head;
                   2021: }
                   2022:
                   2023: ND_pairs nd_minp( ND_pairs d, ND_pairs *prest )
                   2024: {
                   2025:        ND_pairs m,ml,p,l;
                   2026:        unsigned int *lcm;
                   2027:        int s,td,len,tlen,c;
                   2028:
                   2029:        if ( !(p = NEXT(m = d)) ) {
                   2030:                *prest = p;
                   2031:                NEXT(m) = 0;
                   2032:                return m;
                   2033:        }
                   2034:        lcm = m->lcm;
                   2035:        s = m->sugar;
                   2036:        td = m->td;
                   2037:        len = nd_length(nps[m->i1])+nd_length(nps[m->i2]);
                   2038:        for ( ml = 0, l = m; p; p = NEXT(l = p) ) {
                   2039:                if (p->sugar < s)
                   2040:                        goto find;
                   2041:                else if ( p->sugar == s ) {
                   2042:                        if ( p->td < td )
                   2043:                                goto find;
                   2044:                        else if ( p->td == td ) {
                   2045:                                c = ndl_compare(p->lcm,lcm);
                   2046:                                if ( c < 0 )
                   2047:                                        goto find;
                   2048:                                else if ( c == 0 ) {
                   2049:                                        tlen = nd_length(nps[p->i1])+nd_length(nps[p->i2]);
                   2050:                                        if ( tlen < len )
                   2051:                                                goto find;
                   2052:                                }
                   2053:                        }
                   2054:                }
                   2055:                continue;
                   2056: find:
                   2057:                ml = l;
                   2058:                m = p;
                   2059:                lcm = m->lcm;
                   2060:                s = m->sugar;
                   2061:                td = m->td;
                   2062:                len = tlen;
                   2063:        }
                   2064:        if ( !ml ) *prest = NEXT(m);
                   2065:        else {
                   2066:                NEXT(ml) = NEXT(m);
                   2067:                *prest = d;
                   2068:        }
                   2069:        NEXT(m) = 0;
                   2070:        return m;
                   2071: }
                   2072:
                   2073: int nd_newps(ND a)
                   2074: {
                   2075:        if ( nd_psn == nd_pslen ) {
                   2076:                nd_pslen *= 2;
                   2077:                nps = (ND *)REALLOC((char *)nps,nd_pslen*sizeof(ND));
                   2078:        }
                   2079:        nd_monic(a);
                   2080:        nps[nd_psn] = a;
                   2081:        return nd_psn++;
                   2082: }
                   2083:
                   2084: NODE NODE_sortb(NODE f,int);
                   2085: ND dptond(DP);
                   2086: DP ndtodp(ND);
                   2087:
                   2088: NODE nd_setup(NODE f)
                   2089: {
                   2090:        int i;
                   2091:        NODE s,s0,f0;
                   2092:
                   2093: #if 0
                   2094:        f0 = f = NODE_sortb(f,1);
                   2095: #endif
                   2096:        nd_psn = length(f); nd_pslen = 2*nd_psn;
                   2097:        nps = (ND *)MALLOC(nd_pslen*sizeof(ND));
                   2098:        nd_bpe = 4;
                   2099:        nd_epw = (sizeof(unsigned int)*8)/nd_bpe;
                   2100:        nd_wpd = nd_nvar/nd_epw+(nd_nvar%nd_epw?1:0);
1.13    ! noro     2101:        if ( nd_bpe < 32 ) {
        !          2102:                nd_mask0 = (1<<nd_bpe)-1;
        !          2103:        } else {
        !          2104:                nd_mask0 = 0xffffffff;
        !          2105:        }
1.12      noro     2106:        bzero(nd_mask,sizeof(nd_mask));
                   2107:        for ( i = 0; i < nd_epw; i++ )
                   2108:                nd_mask[nd_epw-i-1] = (nd_mask0<<(i*nd_bpe));
1.11      noro     2109:        nd_free_private_storage();
                   2110:        for ( i = 0; i < nd_psn; i++, f = NEXT(f) ) {
                   2111:                nps[i] = dptond((DP)BDY(f));
                   2112:                nd_monic(nps[i]);
                   2113:        }
                   2114:        for ( s0 = 0, i = 0; i < nd_psn; i++ ) {
                   2115:                NEXTNODE(s0,s); BDY(s) = (pointer)i;
                   2116:        }
                   2117:        if ( s0 ) NEXT(s) = 0;
                   2118:        return s0;
                   2119: }
                   2120:
                   2121: void nd_gr(LIST f,LIST v,int m,struct order_spec *ord,LIST *rp)
                   2122: {
                   2123:        struct order_spec ord1;
                   2124:        VL fv,vv,vc;
                   2125:        NODE fd,fd0,r,r0,t,x,s,xx;
                   2126:        DP a,b,c;
                   2127:
                   2128:        get_vars((Obj)f,&fv); pltovl(v,&vv);
                   2129:        nd_nvar = length(vv);
                   2130:        if ( ord->id )
                   2131:                error("nd_gr : unsupported order");
                   2132:        switch ( ord->ord.simple ) {
                   2133:                case 0:
                   2134:                        is_rlex = 1;
                   2135:                        break;
                   2136:                case 1:
                   2137:                        is_rlex = 0;
                   2138:                        break;
                   2139:                default:
                   2140:                        error("nd_gr : unsupported order");
                   2141:        }
                   2142:        initd(ord);
                   2143:        nd_mod = m;
                   2144:        for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
                   2145:                ptod(CO,vv,(P)BDY(t),&b);
                   2146:                _dp_mod(b,m,0,&c);
                   2147:                if ( c ) {
                   2148:                        NEXTNODE(fd0,fd); BDY(fd) = (pointer)c;
                   2149:                }
                   2150:        }
                   2151:        if ( fd0 ) NEXT(fd) = 0;
                   2152:        s = nd_setup(fd0);
                   2153:        x = nd_gb(s);
                   2154: #if 0
                   2155:        x = nd_reduceall(x,m);
                   2156: #endif
                   2157:        for ( r0 = 0; x; x = NEXT(x) ) {
                   2158:                NEXTNODE(r0,r);
                   2159:                a = ndtodp(nps[(int)BDY(x)]);
                   2160:                _dtop_mod(CO,vv,a,(P *)&BDY(r));
                   2161:        }
                   2162:        if ( r0 ) NEXT(r) = 0;
                   2163:        MKLIST(*rp,r0);
                   2164: }
                   2165:
                   2166: void dltondl(int n,DL dl,unsigned int *r)
                   2167: {
                   2168:        unsigned int *d;
                   2169:        int i;
                   2170:
                   2171:        d = dl->d;
1.12      noro     2172:        bzero(r,nd_wpd*sizeof(unsigned int));
1.11      noro     2173:        if ( is_rlex )
                   2174:                for ( i = 0; i < n; i++ )
                   2175:                        r[(n-1-i)/nd_epw] |= (d[i]<<((nd_epw-((n-1-i)%nd_epw)-1)*nd_bpe));
                   2176:        else
                   2177:                for ( i = 0; i < n; i++ )
                   2178:                        r[i/nd_epw] |= d[i]<<((nd_epw-(i%nd_epw)-1)*nd_bpe);
                   2179: }
                   2180:
                   2181: DL ndltodl(int n,int td,unsigned int *ndl)
                   2182: {
                   2183:        DL dl;
                   2184:        int *d;
                   2185:        int i;
                   2186:
                   2187:        NEWDL(dl,n);
                   2188:        dl->td = td;
                   2189:        d = dl->d;
                   2190:        if ( is_rlex )
                   2191:                for ( i = 0; i < n; i++ )
                   2192:                        d[i] = (ndl[(n-1-i)/nd_epw]>>((nd_epw-((n-1-i)%nd_epw)-1)*nd_bpe))
                   2193:                                &((1<<nd_bpe)-1);
                   2194:        else
                   2195:                for ( i = 0; i < n; i++ )
                   2196:                        d[i] = (ndl[i/nd_epw]>>((nd_epw-(i%nd_epw)-1)*nd_bpe))
                   2197:                                &((1<<nd_bpe)-1);
                   2198:        return dl;
                   2199: }
                   2200:
                   2201: ND dptond(DP p)
                   2202: {
                   2203:        ND d;
                   2204:        NM m0,m;
                   2205:        MP t;
                   2206:        int n;
                   2207:
                   2208:        if ( !p )
                   2209:                return 0;
                   2210:        n = NV(p);
                   2211:        m0 = 0;
                   2212:        for ( t = BDY(p); t; t = NEXT(t) ) {
                   2213:                NEXTNM(m0,m);
                   2214:                m->c = ITOS(t->c);
                   2215:                m->td = t->dl->td;
                   2216:                dltondl(n,t->dl,m->dl);
                   2217:        }
                   2218:        NEXT(m) = 0;
                   2219:        MKND(n,m0,d);
                   2220:        d->nv = n;
                   2221:        d->sugar = p->sugar;
                   2222:        return d;
                   2223: }
                   2224:
                   2225: DP ndtodp(ND p)
                   2226: {
                   2227:        DP d;
                   2228:        MP m0,m;
                   2229:        NM t;
                   2230:        int n;
                   2231:
                   2232:        if ( !p )
                   2233:                return 0;
                   2234:        n = NV(p);
                   2235:        m0 = 0;
                   2236:        for ( t = BDY(p); t; t = NEXT(t) ) {
                   2237:                NEXTMP(m0,m);
                   2238:                m->c = STOI(t->c);
                   2239:                m->dl = ndltodl(n,t->td,t->dl);
                   2240:        }
                   2241:        NEXT(m) = 0;
                   2242:        MKDP(n,m0,d);
                   2243:        d->sugar = p->sugar;
                   2244:        return d;
                   2245: }
                   2246:
                   2247: void ndl_print(unsigned int *dl)
                   2248: {
                   2249:        int n;
                   2250:        int i;
                   2251:
                   2252:        n = nd_nvar;
                   2253:        printf("<<");
                   2254:        if ( is_rlex )
                   2255:                for ( i = 0; i < n; i++ )
                   2256:                        printf(i==n-1?"%d":"%d,",
                   2257:                                (dl[(n-1-i)/nd_epw]>>((nd_epw-((n-1-i)%nd_epw)-1)*nd_bpe))
                   2258:                                        &((1<<nd_bpe)-1));
                   2259:        else
                   2260:                for ( i = 0; i < n; i++ )
                   2261:                        printf(i==n-1?"%d":"%d,",
                   2262:                                (dl[i/nd_epw]>>((nd_epw-(i%nd_epw)-1)*nd_bpe))
                   2263:                                        &((1<<nd_bpe)-1));
                   2264:        printf(">>");
                   2265: }
                   2266:
                   2267: void nd_print(ND p)
                   2268: {
                   2269:        NM m;
                   2270:
                   2271:        if ( !p )
                   2272:                printf("0\n");
                   2273:        else {
                   2274:                for ( m = BDY(p); m; m = NEXT(m) ) {
                   2275:                        printf("+%d*",m->c);
                   2276:                        ndl_print(m->dl);
                   2277:                }
                   2278:                printf("\n");
                   2279:        }
                   2280: }
                   2281:
                   2282: void ndp_print(ND_pairs d)
                   2283: {
                   2284:        ND_pairs t;
                   2285:
                   2286:        for ( t = d; t; t = NEXT(t) ) {
                   2287:                printf("%d,%d ",t->i1,t->i2);
                   2288:        }
                   2289:        printf("\n");
                   2290: }
                   2291:
                   2292: void nd_monic(ND p)
                   2293: {
1.13    ! noro     2294:        if ( !p )
        !          2295:                return;
        !          2296:        else
        !          2297:                nd_mul_c(p,invm(HC(p),nd_mod));
        !          2298: }
        !          2299:
        !          2300: void nd_mul_c(ND p,int mul)
        !          2301: {
1.11      noro     2302:        NM m;
1.13    ! noro     2303:        int c,c1;
1.11      noro     2304:
                   2305:        if ( !p )
                   2306:                return;
1.13    ! noro     2307:        for ( m = BDY(p); m; m = NEXT(m) ) {
        !          2308:                c1 = C(m);
        !          2309:                DMAR(c1,mul,0,nd_mod,c);
        !          2310:                C(m) = c;
        !          2311:        }
1.1       noro     2312: }

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