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

Annotation of OpenXM_contrib2/asir2000/builtin/gr.c, Revision 1.57

1.8       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.9       noro       26:  * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.8       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.57    ! noro       48:  * $OpenXM: OpenXM_contrib2/asir2000/builtin/gr.c,v 1.56 2003/12/26 02:38:10 noro Exp $
1.8       noro       49: */
1.1       noro       50: #include "ca.h"
                     51: #include "parse.h"
                     52: #include "base.h"
                     53: #include "ox.h"
                     54:
1.27      noro       55: #if defined(__GNUC__)
                     56: #define INLINE inline
                     57: #elif defined(VISUAL)
                     58: #define INLINE __inline
                     59: #else
                     60: #define INLINE
                     61: #endif
                     62:
1.1       noro       63: #define HMAG(p) (p_mag(BDY(p)->c))
                     64:
1.37      noro       65: #define NEWDP_pairs ((DP_pairs)MALLOC(sizeof(struct dp_pairs)))
1.1       noro       66:
1.37      noro       67: static DP_pairs collect_pairs_of_hdlcm( DP_pairs d1, DP_pairs *prest );
                     68: double get_rtime();
1.1       noro       69:
1.14      noro       70: struct oEGT eg_nf,eg_nfm;
                     71: struct oEGT eg_znfm,eg_pz,eg_np,eg_ra,eg_mc,eg_gc;
1.1       noro       72: int TP,NBP,NMP,NFP,NDP,ZR,NZR;
                     73:
                     74: extern int (*cmpdl)();
1.5       noro       75: extern int do_weyl;
1.1       noro       76:
1.13      noro       77: extern DP_Print;
                     78:
1.1       noro       79: extern int dp_nelim;
                     80: extern int dp_fcoeffs;
                     81: static DP *ps,*psm;
                     82: static DL *psh;
                     83: static P *psc;
                     84:
                     85: static int *pss;
                     86: static int psn,pslen;
1.16      noro       87: static int NVars,CNVars;
1.1       noro       88: static VL VC;
1.14      noro       89:
1.16      noro       90: int PCoeffs;
1.14      noro       91: int DP_Print = 0;
1.46      noro       92: int DP_PrintShort = 0;
1.14      noro       93: int DP_Multiple = 0;
1.16      noro       94: int DP_NFStat = 0;
1.14      noro       95: LIST Dist = 0;
                     96: int NoGCD = 0;
                     97: int GenTrace = 0;
                     98: int OXCheck = -1;
                     99:
1.54      noro      100: int NoSugar = 0;
1.1       noro      101: static int NoCriB = 0;
                    102: static int NoGC = 0;
                    103: static int NoMC = 0;
                    104: static int NoRA = 0;
                    105: static int ShowMag = 0;
                    106: static int Stat = 0;
                    107: static int Denominator = 1;
1.53      noro      108: int Top = 0;
                    109: int Reverse = 0;
1.1       noro      110: static int Max_mag = 0;
1.42      noro      111: static int Max_coef = 0;
1.54      noro      112: char *Demand = 0;
1.1       noro      113: static int PtozpRA = 0;
1.14      noro      114:
1.1       noro      115: int doing_f4;
1.7       noro      116: NODE TraceList;
1.23      noro      117: NODE AllTraceList;
1.1       noro      118:
1.37      noro      119: void Pox_cmo_rpc(NODE,Obj *);
                    120: void Pox_rpc(NODE,Obj *);
                    121: void Pox_pop_local(NODE,Obj *);
                    122:
                    123: INLINE int eqdl(int nv,DL dl1,DL dl2)
1.1       noro      124: {
                    125:        int i;
1.51      noro      126:        int *p1,*p2;
1.1       noro      127:
                    128:        if ( dl1->td != dl2->td )
                    129:                return 0;
1.51      noro      130:        i = nv-1;
                    131:        p1 = dl1->d;
                    132:        p2 = dl2->d;
                    133:        while ( i >= 7 ) {
                    134:                if ( *p1++ != *p2++ ) return 0;
                    135:                if ( *p1++ != *p2++ ) return 0;
                    136:                if ( *p1++ != *p2++ ) return 0;
                    137:                if ( *p1++ != *p2++ ) return 0;
                    138:                if ( *p1++ != *p2++ ) return 0;
                    139:                if ( *p1++ != *p2++ ) return 0;
                    140:                if ( *p1++ != *p2++ ) return 0;
                    141:                if ( *p1++ != *p2++ ) return 0;
                    142:                i -= 8;
                    143:        }
                    144:        switch ( i ) {
                    145:                case 6:
                    146:                        if ( *p1++ != *p2++ ) return 0;
                    147:                        if ( *p1++ != *p2++ ) return 0;
                    148:                        if ( *p1++ != *p2++ ) return 0;
                    149:                        if ( *p1++ != *p2++ ) return 0;
                    150:                        if ( *p1++ != *p2++ ) return 0;
                    151:                        if ( *p1++ != *p2++ ) return 0;
                    152:                        if ( *p1++ != *p2++ ) return 0;
                    153:                        return 1;
                    154:                case 5:
                    155:                        if ( *p1++ != *p2++ ) return 0;
                    156:                        if ( *p1++ != *p2++ ) return 0;
                    157:                        if ( *p1++ != *p2++ ) return 0;
                    158:                        if ( *p1++ != *p2++ ) return 0;
                    159:                        if ( *p1++ != *p2++ ) return 0;
                    160:                        if ( *p1++ != *p2++ ) return 0;
                    161:                        return 1;
                    162:                case 4:
                    163:                        if ( *p1++ != *p2++ ) return 0;
                    164:                        if ( *p1++ != *p2++ ) return 0;
                    165:                        if ( *p1++ != *p2++ ) return 0;
                    166:                        if ( *p1++ != *p2++ ) return 0;
                    167:                        if ( *p1++ != *p2++ ) return 0;
                    168:                        return 1;
                    169:                case 3:
                    170:                        if ( *p1++ != *p2++ ) return 0;
                    171:                        if ( *p1++ != *p2++ ) return 0;
                    172:                        if ( *p1++ != *p2++ ) return 0;
                    173:                        if ( *p1++ != *p2++ ) return 0;
                    174:                        return 1;
                    175:                case 2:
                    176:                        if ( *p1++ != *p2++ ) return 0;
                    177:                        if ( *p1++ != *p2++ ) return 0;
                    178:                        if ( *p1++ != *p2++ ) return 0;
                    179:                        return 1;
                    180:                case 1:
                    181:                        if ( *p1++ != *p2++ ) return 0;
                    182:                        if ( *p1++ != *p2++ ) return 0;
                    183:                        return 1;
                    184:                case 0:
                    185:                        if ( *p1++ != *p2++ ) return 0;
                    186:                        return 1;
                    187:                default:
                    188:                        return 1;
                    189:        }
1.1       noro      190: }
                    191:
1.5       noro      192: /* b[] should be cleared */
                    193:
1.37      noro      194: void _dpmod_to_vect(DP f,DL *at,int *b)
1.1       noro      195: {
                    196:        int i,nv;
                    197:        MP m;
                    198:
                    199:        nv = f->nv;
                    200:        for ( m = BDY(f), i = 0; m; m = NEXT(m), i++ ) {
                    201:                for ( ; !eqdl(nv,m->dl,at[i]); i++ );
                    202:                b[i] = ITOS(m->c);
                    203:        }
                    204: }
                    205:
1.30      noro      206: /* [t,findex] -> tf -> compressed vector */
                    207:
1.37      noro      208: void _tf_to_vect_compress(NODE tf,DL *at,CDP *b)
1.30      noro      209: {
                    210:        int i,j,k,nv,len;
                    211:        DL t,s,d1;
                    212:        DP f;
                    213:        MP m;
                    214:        CDP r;
                    215:
                    216:        t = (DL)BDY(tf);
                    217:        f = ps[(int)BDY(NEXT(tf))];
                    218:
                    219:        nv = f->nv;
                    220:        for ( m = BDY(f), len = 0; m; m = NEXT(m), len++ );
                    221:        r = (CDP)MALLOC(sizeof(struct oCDP));
                    222:        r->len = len;
1.32      noro      223:        r->psindex = (int)BDY(NEXT(tf));
1.33      noro      224:        r->body = (unsigned int *)MALLOC_ATOMIC(sizeof(unsigned int)*len);
1.30      noro      225:
1.34      noro      226:        NEWDL_NOINIT(s,nv);
1.30      noro      227:        for ( m = BDY(f), i = j = 0; m; m = NEXT(m), j++ ) {
                    228:                d1 = m->dl;
                    229:                s->td = t->td+d1->td;
                    230:                for ( k = 0; k < nv; k++ )
                    231:                        s->d[k] = t->d[k]+d1->d[k];
                    232:                for ( ; !eqdl(nv,s,at[i]); i++ );
1.32      noro      233:                r->body[j] = i;
1.30      noro      234:        }
                    235:        *b = r;
                    236: }
                    237:
1.37      noro      238: void dp_to_vect(DP f,DL *at,Q *b)
1.1       noro      239: {
                    240:        int i,nv;
                    241:        MP m;
                    242:
                    243:        nv = f->nv;
                    244:        for ( m = BDY(f), i = 0; m; m = NEXT(m), i++ ) {
                    245:                for ( ; !eqdl(nv,m->dl,at[i]); i++ );
                    246:                b[i] =(Q)m->c;
                    247:        }
                    248: }
                    249:
1.37      noro      250: NODE dp_dllist(DP f)
1.1       noro      251: {
1.2       noro      252:        MP m;
                    253:        NODE mp,mp0;
1.1       noro      254:
1.2       noro      255:        if ( !f )
                    256:                return 0;
1.1       noro      257:        mp0 = 0;
                    258:        for ( m = BDY(f); m; m = NEXT(m) ) {
1.2       noro      259:                NEXTNODE(mp0,mp); BDY(mp) = (pointer)m->dl;
1.1       noro      260:        }
                    261:        NEXT(mp) = 0;
1.2       noro      262:        return mp0;
                    263: }
                    264:
1.37      noro      265: NODE mul_dllist(DL d,DP f)
1.30      noro      266: {
                    267:        MP m;
                    268:        NODE mp,mp0;
                    269:        DL t,d1;
                    270:        int i,nv;
                    271:
                    272:        if ( !f )
                    273:                return 0;
                    274:        nv = NV(f);
                    275:        mp0 = 0;
                    276:        for ( m = BDY(f); m; m = NEXT(m) ) {
                    277:                NEXTNODE(mp0,mp);
1.34      noro      278:                NEWDL_NOINIT(t,nv);
1.30      noro      279:                d1 = m->dl;
                    280:                t->td = d->td+d1->td;
                    281:                for ( i = 0; i < nv; i++ )
                    282:                        t->d[i] = d->d[i]+d1->d[i];
                    283:                BDY(mp) = (pointer)t;
                    284:        }
                    285:        NEXT(mp) = 0;
                    286:        return mp0;
                    287: }
                    288:
1.37      noro      289: void pdl(NODE f)
1.2       noro      290: {
                    291:        while ( f ) {
                    292:                printdl(BDY(f)); f = NEXT(f);
                    293:        }
                    294:        fflush(stdout);
                    295:        printf("\n");
1.1       noro      296: }
                    297:
1.37      noro      298: void dp_gr_main(LIST f,LIST v,Num homo,int modular,int field,struct order_spec *ord,LIST *rp)
1.1       noro      299: {
                    300:        int i,mindex,m,nochk;
1.57    ! noro      301:        struct order_spec *ord1;
1.23      noro      302:        Q q;
1.1       noro      303:        VL fv,vv,vc;
                    304:        NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx;
1.23      noro      305:        NODE ind,ind0;
                    306:        LIST trace,gbindex;
1.55      noro      307:        int input_is_dp = 0;
1.1       noro      308:
1.21      noro      309:        mindex = 0; nochk = 0; dp_fcoeffs = field;
1.1       noro      310:        get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
                    311:        NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
                    312:        CNVars = homo ? NVars+1 : NVars;
                    313:        if ( ord->id && NVars != ord->nv )
                    314:                error("dp_gr_main : invalid order specification");
                    315:        initd(ord);
                    316:        if ( homo ) {
                    317:                homogenize_order(ord,NVars,&ord1);
                    318:                for ( fd0 = fi0 = 0, t = BDY(f); t; t = NEXT(t) ) {
                    319:                        NEXTNODE(fd0,fd); NEXTNODE(fi0,fi);
1.55      noro      320:                        if ( BDY(t) && OID(BDY(t)) == O_DP ) {
                    321:                                dp_sort((DP)BDY(t),(DP *)&BDY(fi)); input_is_dp = 1;
                    322:                        } else
                    323:                                ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fi));
                    324:                        dp_homo((DP)BDY(fi),(DP *)&BDY(fd));
1.1       noro      325:                }
                    326:                if ( fd0 ) NEXT(fd) = 0;
                    327:                if ( fi0 ) NEXT(fi) = 0;
1.57    ! noro      328:                initd(ord1);
1.1       noro      329:        } else {
                    330:                for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
1.55      noro      331:                        NEXTNODE(fd0,fd);
                    332:                        if ( BDY(t) && OID(BDY(t)) == O_DP ) {
                    333:                                dp_sort((DP)BDY(t),(DP *)&BDY(fd)); input_is_dp = 1;
                    334:                        } else
                    335:                                ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fd));
1.1       noro      336:                }
                    337:                if ( fd0 ) NEXT(fd) = 0;
                    338:                fi0 = fd0;
                    339:        }
                    340:        if ( modular < 0 ) {
                    341:                modular = -modular; nochk = 1;
                    342:        }
                    343:        if ( modular )
1.19      noro      344:                m = modular > 1 ? modular : get_lprime(mindex);
1.1       noro      345:        else
                    346:                m = 0;
                    347:        makesubst(vc,&subst);
                    348:        setup_arrays(fd0,0,&s);
                    349:        init_stat();
                    350:        while ( 1 ) {
                    351:                if ( homo ) {
1.57    ! noro      352:                        initd(ord1); CNVars = NVars+1;
1.1       noro      353:                }
1.12      noro      354:                if ( DP_Print && modular ) {
1.1       noro      355:                        fprintf(asir_out,"mod= %d, eval = ",m); printsubst(subst);
                    356:                }
                    357:                x = gb(s,m,subst);
                    358:                if ( x ) {
                    359:                        if ( homo ) {
                    360:                                reducebase_dehomo(x,&xx); x = xx;
                    361:                                initd(ord); CNVars = NVars;
                    362:                        }
                    363:                        reduceall(x,&xx); x = xx;
                    364:                        if ( modular ) {
                    365:                                if ( nochk || (membercheck(fi0,x) && gbcheck(x)) )
                    366:                                        break;
                    367:                        } else
                    368:                                break;
                    369:                }
                    370:                if ( modular )
                    371:                        if ( modular > 1 ) {
                    372:                                *rp = 0; return;
                    373:                        } else
1.19      noro      374:                                m = get_lprime(++mindex);
1.1       noro      375:                makesubst(vc,&subst);
                    376:                psn = length(s);
                    377:                for ( i = psn; i < pslen; i++ ) {
                    378:                        pss[i] = 0; psh[i] = 0; psc[i] = 0; ps[i] = 0;
                    379:                }
                    380:        }
1.23      noro      381:        for ( r0 = 0, ind0 = 0; x; x = NEXT(x) ) {
1.1       noro      382:                NEXTNODE(r0,r); dp_load((int)BDY(x),&ps[(int)BDY(x)]);
1.55      noro      383:                if ( input_is_dp )
                    384:                        BDY(r) = (pointer)ps[(int)BDY(x)];
                    385:                else
                    386:                        dtop(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
1.23      noro      387:                NEXTNODE(ind0,ind);
                    388:                STOQ((int)BDY(x),q); BDY(ind) = q;
1.1       noro      389:        }
                    390:        if ( r0 ) NEXT(r) = 0;
1.23      noro      391:        if ( ind0 ) NEXT(ind) = 0;
1.1       noro      392:        MKLIST(*rp,r0);
1.23      noro      393:        MKLIST(gbindex,ind0);
                    394:
                    395:        if ( GenTrace && OXCheck < 0 ) {
                    396:
                    397:                x = AllTraceList;
                    398:                for ( r = 0; x; x = NEXT(x) ) {
                    399:                        MKNODE(r0,BDY(x),r); r = r0;
                    400:                }
                    401:                MKLIST(trace,r);
                    402:                r0 = mknode(3,*rp,gbindex,trace);
                    403:                MKLIST(*rp,r0);
                    404:        }
1.1       noro      405:        print_stat();
                    406:        if ( ShowMag )
1.42      noro      407:                fprintf(asir_out,"\nMax_mag=%d, Max_coef=%d\n",Max_mag, Max_coef);
1.1       noro      408: }
                    409:
1.37      noro      410: void dp_gr_mod_main(LIST f,LIST v,Num homo,int m,struct order_spec *ord,LIST *rp)
1.1       noro      411: {
1.57    ! noro      412:        struct order_spec *ord1;
1.1       noro      413:        VL fv,vv,vc;
                    414:        NODE fd,fd0,r,r0,t,x,s,xx;
                    415:        DP a,b,c;
1.55      noro      416:        extern struct oEGT eg_red_mod;
                    417:        int input_is_dp = 0;
1.1       noro      418:
                    419:        get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
                    420:        NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
                    421:        CNVars = homo ? NVars+1 : NVars;
                    422:        if ( ord->id && NVars != ord->nv )
                    423:                error("dp_gr_mod_main : invalid order specification");
                    424:        initd(ord);
                    425:        if ( homo ) {
                    426:                for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
1.55      noro      427:                        if ( BDY(t) && OID(BDY(t)) == O_DP ) {
                    428:                                dp_sort((DP)BDY(t),&a); input_is_dp = 1;
                    429:                        } else
                    430:                                ptod(CO,vv,(P)BDY(t),&a);
                    431:                        dp_homo(a,&b);
1.1       noro      432:                        if ( PCoeffs )
                    433:                                dp_mod(b,m,0,&c);
                    434:                        else
                    435:                                _dp_mod(b,m,(NODE)0,&c);
                    436:                        if ( c ) {
                    437:                                NEXTNODE(fd0,fd); BDY(fd) = (pointer)c;
                    438:                        }
                    439:                }
1.57    ! noro      440:                homogenize_order(ord,NVars,&ord1); initd(ord1);
1.1       noro      441:        } else {
                    442:                for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
1.55      noro      443:                        if ( BDY(t) && OID(BDY(t)) == O_DP ) {
                    444:                                dp_sort((DP)BDY(t),&b); input_is_dp = 1;
                    445:                        } else
                    446:                                ptod(CO,vv,(P)BDY(t),&b);
1.1       noro      447:                        if ( PCoeffs )
                    448:                                dp_mod(b,m,0,&c);
                    449:                        else
                    450:                                _dp_mod(b,m,0,&c);
                    451:                        if ( c ) {
                    452:                                NEXTNODE(fd0,fd); BDY(fd) = (pointer)c;
                    453:                        }
                    454:                }
                    455:        }
                    456:        if ( fd0 ) NEXT(fd) = 0;
                    457:        setup_arrays(fd0,m,&s);
                    458:        init_stat();
                    459:        if ( homo ) {
1.57    ! noro      460:                initd(ord1); CNVars = NVars+1;
1.1       noro      461:        }
1.17      noro      462: /* init_eg(&eg_red_mod); */
1.1       noro      463:        x = gb_mod(s,m);
1.17      noro      464: /* print_eg("Red_mod",&eg_red_mod); */
1.1       noro      465:        if ( homo ) {
                    466:                reducebase_dehomo(x,&xx); x = xx;
                    467:                initd(ord); CNVars = NVars;
                    468:        }
                    469:        reduceall_mod(x,m,&xx); x = xx;
                    470:        if ( PCoeffs )
                    471:                for ( r0 = 0; x; x = NEXT(x) ) {
1.56      noro      472:                        NEXTNODE(r0,r);
                    473:                        if ( input_is_dp )
                    474:                                mdtodp(ps[(int)BDY(x)],(DP *)&BDY(r));
                    475:                        else
                    476:                                mdtop(CO,m,vv,ps[(int)BDY(x)],(P *)&BDY(r));
1.1       noro      477:                }
                    478:        else
                    479:                for ( r0 = 0; x; x = NEXT(x) ) {
1.56      noro      480:                        NEXTNODE(r0,r);
                    481:                        if ( input_is_dp )
                    482:                                _mdtodp(ps[(int)BDY(x)],(DP *)&BDY(r));
                    483:                        else
                    484:                                _dtop_mod(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
1.1       noro      485:                }
                    486:        print_stat();
                    487:        if ( r0 ) NEXT(r) = 0;
                    488:        MKLIST(*rp,r0);
                    489: }
                    490:
1.37      noro      491: void dp_f4_main(LIST f,LIST v,struct order_spec *ord,LIST *rp)
1.1       noro      492: {
1.37      noro      493:        int homogen;
1.1       noro      494:        VL fv,vv,vc;
1.37      noro      495:        NODE fd,fd0,r,r0,t,x,s,xx;
1.55      noro      496:        int input_is_dp = 0;
1.1       noro      497:
1.22      noro      498:        dp_fcoeffs = 0;
1.1       noro      499:        get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
                    500:        NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
                    501:        CNVars = NVars;
                    502:        if ( ord->id && NVars != ord->nv )
                    503:                error("dp_f4_main : invalid order specification");
                    504:        initd(ord);
1.27      noro      505:        for ( fd0 = 0, t = BDY(f), homogen = 1; t; t = NEXT(t) ) {
1.55      noro      506:                NEXTNODE(fd0,fd);
                    507:                if ( BDY(t) && OID(BDY(t)) == O_DP ) {
                    508:                        dp_sort((DP)BDY(t),(DP *)&BDY(fd)); input_is_dp = 1;
                    509:                } else
                    510:                        ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fd));
1.27      noro      511:                if ( homogen )
                    512:                        homogen = dp_homogeneous(BDY(fd));
1.1       noro      513:        }
                    514:        if ( fd0 ) NEXT(fd) = 0;
                    515:        setup_arrays(fd0,0,&s);
                    516:        x = gb_f4(s);
1.27      noro      517:        if ( !homogen ) {
                    518:                reduceall(x,&xx); x = xx;
                    519:        }
1.1       noro      520:        for ( r0 = 0; x; x = NEXT(x) ) {
                    521:                NEXTNODE(r0,r); dp_load((int)BDY(x),&ps[(int)BDY(x)]);
1.55      noro      522:                if ( input_is_dp )
                    523:                        BDY(r) = (pointer)ps[(int)BDY(x)];
                    524:                else
                    525:                        dtop(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
1.1       noro      526:        }
                    527:        if ( r0 ) NEXT(r) = 0;
                    528:        MKLIST(*rp,r0);
                    529: }
                    530:
1.37      noro      531: void dp_f4_mod_main(LIST f,LIST v,int m,struct order_spec *ord,LIST *rp)
1.1       noro      532: {
1.37      noro      533:        int homogen;
1.1       noro      534:        VL fv,vv,vc;
1.5       noro      535:        DP b,c,c1;
1.37      noro      536:        NODE fd,fd0,r,r0,t,x,s,xx;
1.55      noro      537:        int input_is_dp = 0;
1.1       noro      538:
                    539:        dp_fcoeffs = 0;
                    540:        get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
                    541:        NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
                    542:        CNVars = NVars;
                    543:        if ( ord->id && NVars != ord->nv )
                    544:                error("dp_f4_mod_main : invalid order specification");
                    545:        initd(ord);
1.27      noro      546:        for ( fd0 = 0, t = BDY(f), homogen = 1; t; t = NEXT(t) ) {
1.55      noro      547:                if ( BDY(t) && OID(BDY(t)) == O_DP ) {
                    548:                        dp_sort((DP)BDY(t),&b); input_is_dp = 1;
                    549:                } else
                    550:                        ptod(CO,vv,(P)BDY(t),&b);
1.27      noro      551:                if ( homogen )
                    552:                        homogen = dp_homogeneous(b);
1.1       noro      553:                _dp_mod(b,m,0,&c);
1.5       noro      554:                _dp_monic(c,m,&c1);
1.1       noro      555:                if ( c ) {
1.5       noro      556:                        NEXTNODE(fd0,fd); BDY(fd) = (pointer)c1;
1.1       noro      557:                }
                    558:        }
                    559:        if ( fd0 ) NEXT(fd) = 0;
                    560:        setup_arrays(fd0,m,&s);
1.35      noro      561:        init_stat();
1.36      noro      562:        if ( do_weyl )
                    563:                x = gb_f4_mod_old(s,m);
                    564:        else
                    565:                x = gb_f4_mod(s,m);
1.27      noro      566:        if ( !homogen ) {
                    567:                reduceall_mod(x,m,&xx); x = xx;
                    568:        }
1.1       noro      569:        for ( r0 = 0; x; x = NEXT(x) ) {
1.56      noro      570:                NEXTNODE(r0,r);
                    571:                if ( input_is_dp )
                    572:                        _mdtodp(ps[(int)BDY(x)],(DP *)&BDY(r));
                    573:                else
                    574:                        _dtop_mod(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
1.1       noro      575:        }
                    576:        if ( r0 ) NEXT(r) = 0;
                    577:        MKLIST(*rp,r0);
1.35      noro      578:        print_stat();
1.1       noro      579: }
                    580:
1.37      noro      581: NODE gb_f4(NODE f)
1.1       noro      582: {
1.37      noro      583:        int i,k,nh,row,col,nv;
1.1       noro      584:        NODE r,g,gall;
1.2       noro      585:        NODE s,s0;
1.1       noro      586:        DP_pairs d,dm,dr,t;
1.37      noro      587:        DP nf,nf1,f2,sp,sd,tdp;
1.1       noro      588:        MP mp,mp0;
1.37      noro      589:        NODE blist,bt;
1.1       noro      590:        DL *ht,*at;
                    591:        MAT mat,nm;
                    592:        int *rind,*cind;
                    593:        int rank,nred;
                    594:        Q dn;
1.37      noro      595:        struct oEGT tmp0,tmp1,eg_split_symb;
1.1       noro      596:        extern struct oEGT eg_mod,eg_elim,eg_chrem,eg_gschk,eg_intrat,eg_symb;
                    597:
                    598:        init_eg(&eg_mod); init_eg(&eg_elim); init_eg(&eg_chrem);
                    599:        init_eg(&eg_gschk); init_eg(&eg_intrat); init_eg(&eg_symb);
                    600:
                    601:        doing_f4 = 1;
                    602:        for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
                    603:                i = (int)BDY(r);
                    604:                d = updpairs(d,g,i);
                    605:                g = updbase(g,i);
                    606:                gall = append_one(gall,i);
                    607:        }
                    608:        if ( gall )
                    609:                nv = ((DP)ps[(int)BDY(gall)])->nv;
                    610:        while ( d ) {
                    611:                get_eg(&tmp0);
                    612:                minsugar(d,&dm,&dr); d = dr;
1.12      noro      613:                if ( DP_Print )
1.1       noro      614:                        fprintf(asir_out,"sugar=%d\n",dm->sugar);
                    615:                blist = 0; s0 = 0;
                    616:                /* asph : sum of all head terms of spoly */
                    617:                for ( t = dm; t; t = NEXT(t) ) {
                    618:                        dp_sp(ps[t->dp1],ps[t->dp2],&sp);
                    619:                        if ( sp ) {
                    620:                                MKNODE(bt,sp,blist); blist = bt;
1.2       noro      621:                                s0 = symb_merge(s0,dp_dllist(sp),nv);
1.1       noro      622:                        }
                    623:                }
                    624:                /* s0 : all the terms appeared in symbolic redunction */
1.2       noro      625:                for ( s = s0, nred = 0; s; s = NEXT(s) ) {
1.1       noro      626:                        for ( r = gall; r; r = NEXT(r) )
1.2       noro      627:                                if ( _dl_redble(BDY(ps[(int)BDY(r)])->dl,BDY(s),nv) )
1.1       noro      628:                                        break;
                    629:                        if ( r ) {
1.2       noro      630:                                dltod(BDY(s),nv,&tdp);
                    631:                                dp_subd(tdp,ps[(int)BDY(r)],&sd);
1.5       noro      632:                                muld(CO,sd,ps[(int)BDY(r)],&f2);
1.1       noro      633:                                MKNODE(bt,f2,blist); blist = bt;
1.2       noro      634:                                s = symb_merge(s,dp_dllist(f2),nv);
1.1       noro      635:                                nred++;
                    636:                        }
                    637:                }
                    638:
                    639:                /* the first nred polys in blist are reducers */
                    640:                /* row = the number of all the polys */
                    641:                for ( r = blist, row = 0; r; r = NEXT(r), row++ );
                    642:                ht = (DL *)MALLOC(nred*sizeof(DL));
                    643:                for ( r = blist, i = 0; i < nred; r = NEXT(r), i++ )
                    644:                        ht[i] = BDY((DP)BDY(r))->dl;
1.2       noro      645:                for ( s = s0, col = 0; s; s = NEXT(s), col++ );
1.1       noro      646:                at = (DL *)MALLOC(col*sizeof(DL));
1.2       noro      647:                for ( s = s0, i = 0; i < col; s = NEXT(s), i++ )
                    648:                        at[i] = (DL)BDY(s);
1.1       noro      649:                MKMAT(mat,row,col);
                    650:                for ( i = 0, r = blist; i < row; r = NEXT(r), i++ )
                    651:                        dp_to_vect(BDY(r),at,(Q *)mat->body[i]);
                    652:                get_eg(&tmp1); add_eg(&eg_symb,&tmp0,&tmp1);
                    653:                init_eg(&eg_split_symb); add_eg(&eg_split_symb,&tmp0,&tmp1);
1.12      noro      654:                if ( DP_Print ) {
1.1       noro      655:                        print_eg("Symb",&eg_split_symb);
                    656:                        fprintf(asir_out,"mat : %d x %d",row,col);
                    657:                        fflush(asir_out);
                    658:                }
1.3       noro      659: #if 0
                    660:                rank = generic_gauss_elim_hensel(mat,&nm,&dn,&rind,&cind);
                    661: #else
1.1       noro      662:                rank = generic_gauss_elim(mat,&nm,&dn,&rind,&cind);
1.3       noro      663: #endif
1.12      noro      664:                if ( DP_Print )
1.1       noro      665:                        fprintf(asir_out,"done rank = %d\n",rank,row,col);
                    666:                for ( i = 0; i < rank; i++ ) {
                    667:                        for ( k = 0; k < nred; k++ )
                    668:                                if ( !cmpdl(nv,at[rind[i]],ht[k]) )
                    669:                                        break;
                    670:                        if ( k == nred ) {
                    671:                                /* this is a new base */
                    672:                                mp0 = 0;
                    673:                                NEXTMP(mp0,mp); mp->dl = at[rind[i]]; mp->c = (P)dn;
                    674:                                for ( k = 0; k < col-rank; k++ )
                    675:                                        if ( nm->body[i][k] ) {
                    676:                                                NEXTMP(mp0,mp); mp->dl = at[cind[k]];
                    677:                                                mp->c = (P)nm->body[i][k];
                    678:                                        }
                    679:                                NEXT(mp) = 0;
                    680:                                MKDP(nv,mp0,nf); nf->sugar = dm->sugar;
                    681:                                dp_ptozp(nf,&nf1);
                    682:                                nh = newps(nf1,0,0);
                    683:                                d = updpairs(d,g,nh);
                    684:                                g = updbase(g,nh);
                    685:                                gall = append_one(gall,nh);
                    686:                        }
                    687:                }
                    688:        }
1.12      noro      689:        if ( DP_Print ) {
1.1       noro      690:                print_eg("Symb",&eg_symb);
                    691:                print_eg("Mod",&eg_mod); print_eg("GaussElim",&eg_elim);
                    692:                print_eg("ChRem",&eg_chrem); print_eg("IntToRat",&eg_intrat);
                    693:                print_eg("Check",&eg_gschk);
                    694:        }
                    695:        return g;
                    696: }
                    697:
1.5       noro      698: /* initial bases are monic */
                    699:
1.32      noro      700: unsigned int **psca;
1.51      noro      701: GeoBucket create_bucket();
                    702: DL remove_head_bucket(GeoBucket,int);
1.32      noro      703:
1.37      noro      704: NODE gb_f4_mod(NODE f,int m)
1.1       noro      705: {
                    706:        int i,j,k,nh,row,col,nv;
                    707:        NODE r,g,gall;
1.29      noro      708:        NODE s,s0;
1.1       noro      709:        DP_pairs d,dm,dr,t;
1.37      noro      710:        DP nf,sp,sd,tdp;
1.1       noro      711:        MP mp,mp0;
1.37      noro      712:        NODE blist,bt,bt1,dt;
                    713:        DL *at,*st;
1.24      noro      714:        int **spmat;
                    715:        CDP *redmat;
1.25      noro      716:        int *colstat,*w,*w1;
1.35      noro      717:        int rank,nred,nsp,nsp0,nonzero,spcol;
1.24      noro      718:        int *indred,*isred;
                    719:        CDP ri;
1.32      noro      720:        int pscalen;
1.51      noro      721:        GeoBucket bucket;
                    722:        DL head;
1.50      noro      723:        struct oEGT tmp0,tmp1,eg_split_symb,eg_split_conv,eg_split_elim1,eg_split_elim2;
                    724:        extern struct oEGT eg_symb,eg_conv,eg_elim1,eg_elim2;
1.1       noro      725:
1.32      noro      726:        /* initialize coeffcient array list of ps[] */
                    727:        pscalen = pslen;
                    728:        psca = (unsigned int **)MALLOC(pscalen*sizeof(unsigned int *));
                    729:
1.50      noro      730:        init_eg(&eg_symb); init_eg(&eg_conv); init_eg(&eg_elim1); init_eg(&eg_elim2);
1.1       noro      731:        for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
                    732:                i = (int)BDY(r);
                    733:                d = updpairs(d,g,i);
                    734:                g = updbase(g,i);
                    735:                gall = append_one(gall,i);
1.32      noro      736:                dptoca(ps[i],&psca[i]);
1.1       noro      737:        }
                    738:        if ( gall )
                    739:                nv = ((DP)ps[(int)BDY(gall)])->nv;
                    740:        while ( d ) {
                    741:                get_eg(&tmp0);
                    742:                minsugar(d,&dm,&dr); d = dr;
1.12      noro      743:                if ( DP_Print )
1.1       noro      744:                        fprintf(asir_out,"sugar=%d\n",dm->sugar);
1.51      noro      745:                blist = 0;
                    746:                bucket = create_bucket();
1.1       noro      747:                /* asph : sum of all head terms of spoly */
                    748:                for ( t = dm; t; t = NEXT(t) ) {
1.13      noro      749:                        _dp_sp_mod(ps[t->dp1],ps[t->dp2],m,&sp);
1.36      noro      750: /*                     fprintf(stderr,"splen=%d-",dp_nt(sp)); */
1.1       noro      751:                        if ( sp ) {
                    752:                                MKNODE(bt,sp,blist); blist = bt;
1.51      noro      753:                                add_bucket(bucket,dp_dllist(sp),nv);
1.36      noro      754: /*                             fprintf(stderr,"%d-",length(s0)); */
1.1       noro      755:                        }
                    756:                }
1.51      noro      757: #if 0
1.35      noro      758:                if ( DP_Print )
                    759:                        fprintf(asir_out,"initial spmat : %d x %d ",length(blist),length(s0));
1.51      noro      760: #endif
1.24      noro      761:                /* s0 : all the terms appeared in symbolic reduction */
1.51      noro      762:                nred = 0;
                    763:                s0 = 0;
                    764:                while ( 1 ) {
                    765:                        head = remove_head_bucket(bucket,nv);
                    766:                        if ( !head ) break;
                    767:                        else {
                    768:                                NEXTNODE(s0,s);
                    769:                                BDY(s) = (pointer)head;
                    770:                        }
1.29      noro      771:                        for ( r = gall; r; r = NEXT(r) )
1.51      noro      772:                                if ( _dl_redble(BDY(ps[(int)BDY(r)])->dl,head,nv) )
1.29      noro      773:                                        break;
                    774:                        if ( r ) {
1.51      noro      775:                                dltod(head,nv,&tdp);
1.29      noro      776:                                dp_subd(tdp,ps[(int)BDY(r)],&sd);
1.30      noro      777:                                dt = mul_dllist(BDY(sd)->dl,ps[(int)BDY(r)]);
1.51      noro      778:                                add_bucket(bucket,NEXT(dt),nv);
1.48      noro      779: /*                             fprintf(stderr,"[%d]",length(dt)); */
1.30      noro      780:                                /* list of [t,f] */
                    781:                                bt1 = mknode(2,BDY(sd)->dl,BDY(r));
                    782:                                MKNODE(bt,bt1,blist); blist = bt;
1.48      noro      783: /*                             fprintf(stderr,"%d-",length(s0));  */
1.29      noro      784:                                nred++;
1.1       noro      785:                        }
                    786:                }
1.51      noro      787:                if ( s0 ) NEXT(s) = 0;
1.36      noro      788: /*             fprintf(stderr,"\n"); */
1.50      noro      789:                get_eg(&tmp1); add_eg(&eg_symb,&tmp0,&tmp1);
                    790:                init_eg(&eg_split_symb); add_eg(&eg_split_symb,&tmp0,&tmp1);
                    791:
1.35      noro      792:                if ( DP_Print )
                    793:                        fprintf(asir_out,"number of reducers : %d\n",nred);
1.1       noro      794:
1.50      noro      795:                get_eg(&tmp0);
1.1       noro      796:                /* the first nred polys in blist are reducers */
                    797:                /* row = the number of all the polys */
                    798:                for ( r = blist, row = 0; r; r = NEXT(r), row++ );
1.5       noro      799:
                    800:                /* col = number of all terms */
1.29      noro      801:                for ( s = s0, col = 0; s; s = NEXT(s), col++ );
1.5       noro      802:
                    803:                /* head terms of all terms */
1.1       noro      804:                at = (DL *)MALLOC(col*sizeof(DL));
1.29      noro      805:                for ( s = s0, i = 0; i < col; s = NEXT(s), i++ )
                    806:                        at[i] = (DL)BDY(s);
1.5       noro      807:
                    808:                /* store coefficients separately in spmat and redmat */
                    809:                nsp = row-nred;
                    810:
                    811:                /* reducer matrix */
1.25      noro      812:                /* indred : register the position of the head term */
1.24      noro      813:                redmat = (CDP *)MALLOC(nred*sizeof(CDP));
1.5       noro      814:                for ( i = 0, r = blist; i < nred; r = NEXT(r), i++ )
1.30      noro      815:                        _tf_to_vect_compress(BDY(r),at,&redmat[i]);
1.32      noro      816:
1.5       noro      817:                /* register the position of the head term */
1.31      noro      818:                indred = (int *)MALLOC_ATOMIC(nred*sizeof(int));
1.5       noro      819:                bzero(indred,nred*sizeof(int));
1.31      noro      820:                isred = (int *)MALLOC_ATOMIC(col*sizeof(int));
1.5       noro      821:                bzero(isred,col*sizeof(int));
                    822:                for ( i = 0; i < nred; i++ ) {
                    823:                        ri = redmat[i];
1.32      noro      824:                        indred[i] = ri->body[0];
1.24      noro      825:                        isred[indred[i]] = 1;
1.5       noro      826:                }
                    827:
                    828:                spcol = col-nred;
                    829:                /* head terms not in ht */
                    830:                st = (DL *)MALLOC(spcol*sizeof(DL));
                    831:                for ( j = 0, k = 0; j < col; j++ )
                    832:                        if ( !isred[j] )
                    833:                                st[k++] = at[j];
1.50      noro      834:                get_eg(&tmp1); add_eg(&eg_conv,&tmp0,&tmp1);
                    835:                init_eg(&eg_split_conv); add_eg(&eg_split_conv,&tmp0,&tmp1);
1.5       noro      836:
1.24      noro      837:                get_eg(&tmp1);
1.5       noro      838:                /* spoly matrix; stored in reduced form; terms in ht[] are omitted */
1.25      noro      839:                spmat = (int **)MALLOC(nsp*sizeof(int *));
1.31      noro      840:                w = (int *)MALLOC_ATOMIC(col*sizeof(int));
1.25      noro      841:
                    842:                /* skip reducers in blist */
                    843:                for ( i = 0, r = blist; i < nred; r = NEXT(r), i++ );
                    844:                for ( i = 0; r; r = NEXT(r) ) {
1.5       noro      845:                        bzero(w,col*sizeof(int));
                    846:                        _dpmod_to_vect(BDY(r),at,w);
1.24      noro      847:                        reduce_sp_by_red_mod_compress(w,redmat,indred,nred,col,m);
1.25      noro      848:                        for ( j = 0; j < col; j++ )
                    849:                                if ( w[j] )
                    850:                                        break;
                    851:                        if ( j < col ) {
                    852:                                w1 = (int *)MALLOC_ATOMIC(spcol*sizeof(int));
                    853:                                for ( j = 0, k = 0; j < col; j++ )
                    854:                                        if ( !isred[j] )
                    855:                                                w1[k++] = w[j];
                    856:                                spmat[i] = w1;
                    857:                                i++;
                    858:                        }
1.5       noro      859:                }
1.25      noro      860:                /* update nsp */
1.35      noro      861:                nsp0 = nsp;
1.25      noro      862:                nsp = i;
1.5       noro      863:
1.30      noro      864:                /* XXX free redmat explicitly */
                    865:                for ( k = 0; k < nred; k++ ) {
                    866:                        GC_free(BDY(redmat[k]));
                    867:                        GC_free(redmat[k]);
                    868:                }
                    869:
1.5       noro      870:                get_eg(&tmp0); add_eg(&eg_elim1,&tmp1,&tmp0);
                    871:                init_eg(&eg_split_elim1); add_eg(&eg_split_elim1,&tmp1,&tmp0);
                    872:
                    873:                colstat = (int *)MALLOC_ATOMIC(spcol*sizeof(int));
1.25      noro      874:                bzero(colstat,spcol*sizeof(int));
1.5       noro      875:                for ( i = 0, nonzero=0; i < nsp; i++ )
                    876:                        for ( j = 0; j < spcol; j++ )
                    877:                                if ( spmat[i][j] )
1.1       noro      878:                                        nonzero++;
1.17      noro      879:                if ( DP_Print && nsp )
1.5       noro      880:                        fprintf(asir_out,"spmat : %d x %d (nonzero=%f%%)...",
                    881:                                nsp,spcol,((double)nonzero*100)/(nsp*spcol));
1.17      noro      882:                if ( nsp )
                    883:                        rank = generic_gauss_elim_mod(spmat,nsp,spcol,m,colstat);
                    884:                else
                    885:                        rank = 0;
1.5       noro      886:                get_eg(&tmp1); add_eg(&eg_elim2,&tmp0,&tmp1);
                    887:                init_eg(&eg_split_elim2); add_eg(&eg_split_elim2,&tmp0,&tmp1);
                    888:
1.12      noro      889:                if ( DP_Print ) {
1.1       noro      890:                        fprintf(asir_out,"done rank = %d\n",rank,row,col);
                    891:                        print_eg("Symb",&eg_split_symb);
1.50      noro      892:                        print_eg("Conv",&eg_split_conv);
1.5       noro      893:                        print_eg("Elim1",&eg_split_elim1);
                    894:                        print_eg("Elim2",&eg_split_elim2);
1.1       noro      895:                        fprintf(asir_out,"\n");
                    896:                }
1.25      noro      897:
1.35      noro      898:                NZR += rank;
                    899:                ZR += nsp0-rank;
                    900:
1.25      noro      901:                if ( !rank )
                    902:                        continue;
                    903:
1.5       noro      904:                for ( j = 0, i = 0; j < spcol; j++ )
1.1       noro      905:                        if ( colstat[j] ) {
1.5       noro      906:                                mp0 = 0;
1.13      noro      907:                                NEXTMP(mp0,mp); mp->dl = st[j]; mp->c = STOI(1);
1.5       noro      908:                                for ( k = j+1; k < spcol; k++ )
                    909:                                        if ( !colstat[k] && spmat[i][k] ) {
1.13      noro      910:                                                NEXTMP(mp0,mp); mp->dl = st[k];
1.5       noro      911:                                                mp->c = STOI(spmat[i][k]);
1.1       noro      912:                                }
1.5       noro      913:                                NEXT(mp) = 0;
                    914:                                MKDP(nv,mp0,nf); nf->sugar = dm->sugar;
                    915:                                nh = newps_mod(nf,m);
1.32      noro      916:                                if ( nh == pscalen ) {
                    917:                                        psca = (unsigned int **)
                    918:                                                REALLOC(psca,2*pscalen*sizeof(unsigned int *));
                    919:                                        pscalen *= 2;
                    920:                                }
                    921:                                dptoca(ps[nh],&psca[nh]);
1.5       noro      922:                                d = updpairs(d,g,nh);
                    923:                                g = updbase(g,nh);
                    924:                                gall = append_one(gall,nh);
1.1       noro      925:                                i++;
                    926:                        }
1.30      noro      927:
                    928:                /* XXX free spmat[] explicitly */
                    929:                for ( j = 0; j < nsp; j++ ) {
                    930:                        GC_free(spmat[j]);
                    931:                }
1.36      noro      932:        }
                    933:        if ( DP_Print ) {
                    934:                print_eg("Symb",&eg_symb);
1.50      noro      935:                print_eg("Conv",&eg_conv);
1.36      noro      936:                print_eg("Elim1",&eg_elim1);
                    937:                print_eg("Elim2",&eg_elim2);
                    938:                fflush(asir_out);
                    939:        }
                    940:        return g;
                    941: }
                    942:
1.37      noro      943: NODE gb_f4_mod_old(NODE f,int m)
1.36      noro      944: {
                    945:        int i,j,k,nh,row,col,nv;
                    946:        NODE r,g,gall;
                    947:        NODE s,s0;
                    948:        DP_pairs d,dm,dr,t;
1.37      noro      949:        DP nf,f2,sp,sd,sdm,tdp;
1.36      noro      950:        MP mp,mp0;
1.37      noro      951:        NODE blist,bt;
1.36      noro      952:        DL *ht,*at,*st;
                    953:        int **spmat,**redmat;
                    954:        int *colstat,*w;
                    955:        int rank,nred,nsp,nonzero,spcol;
                    956:        int *indred,*isred,*ri;
1.37      noro      957:        struct oEGT tmp0,tmp1,eg_split_symb,eg_split_elim1,eg_split_elim2;
1.36      noro      958:        extern struct oEGT eg_symb,eg_elim1,eg_elim2;
                    959:
                    960:        init_eg(&eg_symb); init_eg(&eg_elim1); init_eg(&eg_elim2);
                    961:        for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
                    962:                i = (int)BDY(r);
                    963:                d = updpairs(d,g,i);
                    964:                g = updbase(g,i);
                    965:                gall = append_one(gall,i);
                    966:        }
                    967:        if ( gall )
                    968:                nv = ((DP)ps[(int)BDY(gall)])->nv;
                    969:        while ( d ) {
                    970:                get_eg(&tmp0);
                    971:                minsugar(d,&dm,&dr); d = dr;
                    972:                if ( DP_Print )
                    973:                        fprintf(asir_out,"sugar=%d\n",dm->sugar);
                    974:                blist = 0; s0 = 0;
                    975:                /* asph : sum of all head terms of spoly */
                    976:                for ( t = dm; t; t = NEXT(t) ) {
                    977:                        _dp_sp_mod(ps[t->dp1],ps[t->dp2],m,&sp);
                    978:                        if ( sp ) {
                    979:                                MKNODE(bt,sp,blist); blist = bt;
                    980:                                s0 = symb_merge(s0,dp_dllist(sp),nv);
                    981:                        }
                    982:                }
                    983:                /* s0 : all the terms appeared in symbolic redunction */
                    984:                for ( s = s0, nred = 0; s; s = NEXT(s) ) {
                    985:                        for ( r = gall; r; r = NEXT(r) )
                    986:                                if ( _dl_redble(BDY(ps[(int)BDY(r)])->dl,BDY(s),nv) )
                    987:                                        break;
                    988:                        if ( r ) {
                    989:                                dltod(BDY(s),nv,&tdp);
                    990:                                dp_subd(tdp,ps[(int)BDY(r)],&sd);
                    991:                                _dp_mod(sd,m,0,&sdm);
                    992:                                mulmd_dup(m,sdm,ps[(int)BDY(r)],&f2);
                    993:                                MKNODE(bt,f2,blist); blist = bt;
                    994:                                s = symb_merge(s,dp_dllist(f2),nv);
                    995:                                nred++;
                    996:                        }
                    997:                }
                    998:
                    999:                get_eg(&tmp1); add_eg(&eg_symb,&tmp0,&tmp1);
                   1000:                init_eg(&eg_split_symb); add_eg(&eg_split_symb,&tmp0,&tmp1);
                   1001:
                   1002:                /* the first nred polys in blist are reducers */
                   1003:                /* row = the number of all the polys */
                   1004:                for ( r = blist, row = 0; r; r = NEXT(r), row++ );
                   1005:
                   1006:                /* head terms of reducers */
                   1007:                ht = (DL *)MALLOC(nred*sizeof(DL));
                   1008:                for ( r = blist, i = 0; i < nred; r = NEXT(r), i++ )
                   1009:                        ht[i] = BDY((DP)BDY(r))->dl;
                   1010:
                   1011:                /* col = number of all terms */
                   1012:                for ( s = s0, col = 0; s; s = NEXT(s), col++ );
                   1013:
                   1014:                /* head terms of all terms */
                   1015:                at = (DL *)MALLOC(col*sizeof(DL));
                   1016:                for ( s = s0, i = 0; i < col; s = NEXT(s), i++ )
                   1017:                        at[i] = (DL)BDY(s);
                   1018:
                   1019:                /* store coefficients separately in spmat and redmat */
                   1020:                nsp = row-nred;
                   1021:
                   1022:                /* reducer matrix */
                   1023:                redmat = (int **)almat(nred,col);
                   1024:                for ( i = 0, r = blist; i < nred; r = NEXT(r), i++ )
                   1025:                        _dpmod_to_vect(BDY(r),at,redmat[i]);
                   1026:                /* XXX */
                   1027: /*             reduce_reducers_mod(redmat,nred,col,m); */
                   1028:                /* register the position of the head term */
                   1029:                indred = (int *)MALLOC(nred*sizeof(int));
                   1030:                bzero(indred,nred*sizeof(int));
                   1031:                isred = (int *)MALLOC(col*sizeof(int));
                   1032:                bzero(isred,col*sizeof(int));
                   1033:                for ( i = 0; i < nred; i++ ) {
                   1034:                        ri = redmat[i];
                   1035:                        for ( j = 0; j < col && !ri[j]; j++ );
                   1036:                        indred[i] = j;
                   1037:                        isred[j] = 1;
                   1038:                }
                   1039:
                   1040:                spcol = col-nred;
                   1041:                /* head terms not in ht */
                   1042:                st = (DL *)MALLOC(spcol*sizeof(DL));
                   1043:                for ( j = 0, k = 0; j < col; j++ )
                   1044:                        if ( !isred[j] )
                   1045:                                st[k++] = at[j];
                   1046:
                   1047:                /* spoly matrix; stored in reduced form; terms in ht[] are omitted */
                   1048:                spmat = almat(nsp,spcol);
                   1049:                w = (int *)MALLOC(col*sizeof(int));
                   1050:                for ( ; i < row; r = NEXT(r), i++ ) {
                   1051:                        bzero(w,col*sizeof(int));
                   1052:                        _dpmod_to_vect(BDY(r),at,w);
                   1053:                        reduce_sp_by_red_mod(w,redmat,indred,nred,col,m);
                   1054:                        for ( j = 0, k = 0; j < col; j++ )
                   1055:                                if ( !isred[j] )
                   1056:                                        spmat[i-nred][k++] = w[j];
                   1057:                }
                   1058:
                   1059:                get_eg(&tmp0); add_eg(&eg_elim1,&tmp1,&tmp0);
                   1060:                init_eg(&eg_split_elim1); add_eg(&eg_split_elim1,&tmp1,&tmp0);
                   1061:
                   1062:                colstat = (int *)MALLOC_ATOMIC(spcol*sizeof(int));
                   1063:                for ( i = 0, nonzero=0; i < nsp; i++ )
                   1064:                        for ( j = 0; j < spcol; j++ )
                   1065:                                if ( spmat[i][j] )
                   1066:                                        nonzero++;
                   1067:                if ( DP_Print && nsp )
                   1068:                        fprintf(asir_out,"spmat : %d x %d (nonzero=%f%%)...",
                   1069:                                nsp,spcol,((double)nonzero*100)/(nsp*spcol));
                   1070:                if ( nsp )
                   1071:                        rank = generic_gauss_elim_mod(spmat,nsp,spcol,m,colstat);
                   1072:                else
                   1073:                        rank = 0;
                   1074:                get_eg(&tmp1); add_eg(&eg_elim2,&tmp0,&tmp1);
                   1075:                init_eg(&eg_split_elim2); add_eg(&eg_split_elim2,&tmp0,&tmp1);
                   1076:
                   1077:                if ( DP_Print ) {
                   1078:                        fprintf(asir_out,"done rank = %d\n",rank,row,col);
                   1079:                        print_eg("Symb",&eg_split_symb);
                   1080:                        print_eg("Elim1",&eg_split_elim1);
                   1081:                        print_eg("Elim2",&eg_split_elim2);
                   1082:                        fprintf(asir_out,"\n");
                   1083:                }
                   1084:                for ( j = 0, i = 0; j < spcol; j++ )
                   1085:                        if ( colstat[j] ) {
                   1086:                                mp0 = 0;
                   1087:                                NEXTMP(mp0,mp); mp->dl = st[j]; mp->c = STOI(1);
                   1088:                                for ( k = j+1; k < spcol; k++ )
                   1089:                                        if ( !colstat[k] && spmat[i][k] ) {
                   1090:                                                NEXTMP(mp0,mp); mp->dl = st[k];
                   1091:                                                mp->c = STOI(spmat[i][k]);
                   1092:                                }
                   1093:                                NEXT(mp) = 0;
                   1094:                                MKDP(nv,mp0,nf); nf->sugar = dm->sugar;
                   1095:                                nh = newps_mod(nf,m);
                   1096:                                d = updpairs(d,g,nh);
                   1097:                                g = updbase(g,nh);
                   1098:                                gall = append_one(gall,nh);
                   1099:                                i++;
                   1100:                        }
1.1       noro     1101:        }
1.12      noro     1102:        if ( DP_Print ) {
1.1       noro     1103:                print_eg("Symb",&eg_symb);
1.5       noro     1104:                print_eg("Elim1",&eg_elim1);
                   1105:                print_eg("Elim2",&eg_elim2);
1.1       noro     1106:                fflush(asir_out);
                   1107:        }
                   1108:        return g;
                   1109: }
                   1110:
1.37      noro     1111: int DPPlength(DP_pairs n)
1.1       noro     1112: {
                   1113:        int i;
                   1114:
                   1115:        for ( i = 0; n; n = NEXT(n), i++ );
                   1116:        return i;
                   1117: }
                   1118:
1.37      noro     1119: void printdl(DL dl)
1.1       noro     1120: {
                   1121:        int i;
                   1122:
                   1123:        fprintf(asir_out,"<<");
                   1124:        for ( i = 0; i < CNVars-1; i++ )
                   1125:                fprintf(asir_out,"%d,",dl->d[i]);
                   1126:        fprintf(asir_out,"%d>>",dl->d[i]);
                   1127: }
                   1128:
1.37      noro     1129: void pltovl(LIST l,VL *vl)
1.1       noro     1130: {
                   1131:        NODE n;
                   1132:        VL r,r0;
                   1133:
                   1134:        n = BDY(l);
                   1135:        for ( r0 = 0; n; n = NEXT(n) ) {
                   1136:                NEXTVL(r0,r); r->v = VR((P)BDY(n));
                   1137:        }
                   1138:        if ( r0 ) NEXT(r) = 0;
                   1139:        *vl = r0;
1.57    ! noro     1140: }
        !          1141:
        !          1142: void vltopl(VL vl,LIST *l)
        !          1143: {
        !          1144:        VL n;
        !          1145:        NODE r,r0;
        !          1146:        P p;
        !          1147:
        !          1148:        n = vl;
        !          1149:        for ( r0 = 0; n; n = NEXT(n) ) {
        !          1150:                NEXTNODE(r0,r); MKV(n->v,p); BDY(r) = (pointer)p;
        !          1151:        }
        !          1152:        if ( r0 ) NEXT(r) = 0;
        !          1153:        MKLIST(*l,r0);
1.1       noro     1154: }
                   1155:
1.37      noro     1156: void makesubst(VL v,NODE *s)
1.1       noro     1157: {
                   1158:        NODE r,r0;
                   1159:        Q q;
                   1160:        unsigned int n;
                   1161:
                   1162:        for ( r0 = 0; v; v = NEXT(v) ) {
                   1163:                NEXTNODE(r0,r); BDY(r) = (pointer)v->v;
                   1164: #if defined(_PA_RISC1_1)
                   1165:                n = mrand48()&BMASK; UTOQ(n,q);
                   1166: #else
                   1167:                n = random(); UTOQ(n,q);
                   1168: #endif
                   1169:                NEXTNODE(r0,r); BDY(r) = (pointer)q;
                   1170:        }
                   1171:        if ( r0 ) NEXT(r) = 0;
                   1172:        *s = r0;
                   1173: }
                   1174:
1.37      noro     1175: void printsubst(NODE s)
1.1       noro     1176: {
                   1177:        fputc('[',asir_out);
                   1178:        while ( s ) {
                   1179:                printv(CO,(V)BDY(s)); s = NEXT(s);
                   1180:                fprintf(asir_out,"->%d",QTOS((Q)BDY(s)));
                   1181:                if ( NEXT(s) ) {
                   1182:                        fputc(',',asir_out); s = NEXT(s);
                   1183:                } else
                   1184:                        break;
                   1185:        }
                   1186:        fprintf(asir_out,"]\n"); return;
                   1187: }
                   1188:
1.37      noro     1189: void vlminus(VL v,VL w,VL *d)
1.1       noro     1190: {
                   1191:        int i,j,n,m;
                   1192:        V *va,*wa;
                   1193:        V a;
                   1194:        VL r,r0;
                   1195:        VL t;
                   1196:
                   1197:        for ( n = 0, t = v; t; t = NEXT(t), n++ );
                   1198:        va = (V *)ALLOCA(n*sizeof(V));
                   1199:        for ( i = 0, t = v; t; t = NEXT(t), i++ )
                   1200:                va[i] = t->v;
                   1201:        for ( m = 0, t = w; t; t = NEXT(t), m++ );
                   1202:        wa = (V *)ALLOCA(m*sizeof(V));
                   1203:        for ( i = 0, t = w; t; t = NEXT(t), i++ )
                   1204:                wa[i] = t->v;
                   1205:        for ( i = 0; i < n; i++ ) {
                   1206:                a = va[i];
                   1207:                for ( j = 0; j < m; j++ )
                   1208:                        if ( a == wa[j] )
                   1209:                                break;
                   1210:                if ( j < m )
                   1211:                        va[i] = 0;
                   1212:        }
                   1213:        for ( r0 = 0, i = 0; i < n; i++ )
                   1214:                if ( va[i] ) { NEXTVL(r0,r); r->v = va[i];      }
                   1215:        if ( r0 ) NEXT(r) = 0;
                   1216:        *d = r0;
                   1217: }
                   1218:
1.37      noro     1219: int validhc(P a,int m,NODE s)
1.1       noro     1220: {
                   1221:        P c,c1;
                   1222:        V v;
                   1223:
                   1224:        if ( !a )
                   1225:                return 0;
                   1226:        for ( c = a; s; s = NEXT(s) ) {
                   1227:                v = (V)BDY(s); s = NEXT(s);
                   1228:                substp(CO,c,v,(P)BDY(s),&c1); c = c1;
                   1229:        }
                   1230:        ptomp(m,c,&c1);
                   1231:        return c1 ? 1 : 0;
                   1232: }
                   1233:
1.37      noro     1234: void setup_arrays(NODE f,int m,NODE *r)
1.1       noro     1235: {
                   1236:        int i;
1.7       noro     1237:        NODE s,s0,f0;
1.1       noro     1238:
1.17      noro     1239: #if 1
1.7       noro     1240:        f0 = f = NODE_sortb(f,1);
1.17      noro     1241: #else
                   1242:        f0 = f;
                   1243: #endif
1.1       noro     1244:        psn = length(f); pslen = 2*psn;
                   1245:        ps = (DP *)MALLOC(pslen*sizeof(DP));
                   1246:        psh = (DL *)MALLOC(pslen*sizeof(DL));
                   1247:        pss = (int *)MALLOC(pslen*sizeof(int));
                   1248:        psc = (P *)MALLOC(pslen*sizeof(P));
                   1249:        for ( i = 0; i < psn; i++, f = NEXT(f) ) {
                   1250:                prim_part((DP)BDY(f),m,&ps[i]);
                   1251:                if ( Demand )
1.7       noro     1252:                        dp_save(i,(Obj)ps[i],0);
1.1       noro     1253:                psh[i] = BDY(ps[i])->dl;
                   1254:                pss[i] = ps[i]->sugar;
                   1255:                psc[i] = BDY(ps[i])->c;
                   1256:        }
1.23      noro     1257:        if ( GenTrace ) {
1.7       noro     1258:                Q q;
                   1259:                STRING fname;
                   1260:                LIST input;
1.23      noro     1261:                NODE arg,t,t1;
1.37      noro     1262:                Obj obj;
1.23      noro     1263:
                   1264:                t = 0;
                   1265:                for ( i = psn-1; i >= 0; i-- ) {
                   1266:                        MKNODE(t1,ps[i],t);
                   1267:                        t = t1;
                   1268:                }
                   1269:                MKLIST(input,t);
1.7       noro     1270:
1.23      noro     1271:                if ( OXCheck >= 0 ) {
                   1272:                        STOQ(OXCheck,q);
                   1273:                        MKSTR(fname,"register_input");
                   1274:                        arg = mknode(3,q,fname,input);
1.37      noro     1275:                        Pox_cmo_rpc(arg,&obj);
1.23      noro     1276:                } else if ( OXCheck < 0 ) {
                   1277:                        MKNODE(AllTraceList,input,0);
                   1278:                }
1.7       noro     1279:        }
1.1       noro     1280:        for ( s0 = 0, i = 0; i < psn; i++ ) {
                   1281:                NEXTNODE(s0,s); BDY(s) = (pointer)i;
                   1282:        }
                   1283:        if ( s0 ) NEXT(s) = 0;
                   1284:        *r = s0;
                   1285: }
                   1286:
1.37      noro     1287: void prim_part(DP f,int m,DP *r)
1.1       noro     1288: {
1.7       noro     1289:        P d,t;
                   1290:
1.1       noro     1291:        if ( m > 0 ) {
                   1292:                if ( PCoeffs )
                   1293:                        dp_prim_mod(f,m,r);
                   1294:                else
1.49      noro     1295:                        _dp_monic(f,m,r);
1.1       noro     1296:        } else {
1.44      noro     1297:                if ( dp_fcoeffs || PCoeffs )
1.1       noro     1298:                        dp_prim(f,r);
                   1299:                else
                   1300:                        dp_ptozp(f,r);
1.7       noro     1301:                if ( GenTrace && TraceList ) {
1.23      noro     1302:                        /* adust the denominator according to the final
                   1303:                           content reduction */
1.7       noro     1304:                        divsp(CO,BDY(f)->c,BDY(*r)->c,&d);
                   1305:                        mulp(CO,(P)ARG3(BDY((LIST)BDY(TraceList))),d,&t);
                   1306:                        ARG3(BDY((LIST)BDY(TraceList))) = t;
                   1307:                }
1.1       noro     1308:        }
                   1309: }
                   1310:
1.37      noro     1311: NODE /* of DP */ NODE_sortb_insert( DP newdp, NODE /* of DP */ nd, int dec )
1.1       noro     1312: {
                   1313:        register NODE last, p;
                   1314:        register DL newdl = BDY(newdp)->dl;
                   1315:        register int (*cmpfun)() = cmpdl, nv = CNVars;
                   1316:        NODE newnd;
                   1317:        int sgn = dec ? 1 : -1;
                   1318:        MKNODE( newnd, newdp, 0 );
                   1319:        if ( !(last = nd) || sgn*(*cmpfun)( nv, newdl, BDY((DP) BDY(last))->dl ) > 0 ) {
                   1320:                NEXT(newnd) = last;
                   1321:                return newnd;
                   1322:        }
                   1323:        for ( ; p = NEXT(last); last = p )
                   1324:                if ( sgn*(*cmpfun)( nv, newdl, BDY((DP) BDY(p))->dl ) > 0 ) break;
                   1325:        if ( p ) NEXT(NEXT(last) = newnd) = p;
                   1326:        else NEXT(last) = newnd;
                   1327:        return nd;
                   1328: }
                   1329:
1.37      noro     1330: NODE NODE_sortb( NODE node, int dec )
1.1       noro     1331: {
                   1332:        register NODE nd, ans;
                   1333:
                   1334:        for ( ans = 0, nd = node; nd; nd = NEXT(nd) )
                   1335:                ans = NODE_sortb_insert( (DP) BDY(nd), ans, dec );
                   1336:        return ans;
                   1337: }
                   1338:
1.37      noro     1339: NODE /* of index */ NODE_sortbi_insert( int newdpi, NODE /* of index */ nd, int dec )
1.1       noro     1340: {
                   1341:        register NODE last, p;
                   1342:        register DL newdl = psh[newdpi];
                   1343:        register int (*cmpfun)() = cmpdl, nv = CNVars;
                   1344:        NODE newnd;
                   1345:        int sgn = dec ? 1 : -1;
                   1346:        MKNODE( newnd, newdpi, 0 );
                   1347:        if ( !(last = nd) || sgn*(*cmpfun)( nv, newdl, psh[(int)BDY(last)] ) > 0 ) {
                   1348:                NEXT(newnd) = last;
                   1349:                return newnd;
                   1350:        }
                   1351:        for ( ; p = NEXT(last); last = p )
                   1352:                if ( sgn*(*cmpfun)( nv, newdl, psh[(int)BDY(p)] ) > 0 ) break;
                   1353:        if ( p ) NEXT(NEXT(last) = newnd) = p;
                   1354:        else NEXT(last) = newnd;
                   1355:        return nd;
                   1356: }
                   1357:
1.37      noro     1358: NODE NODE_sortbi( NODE node, int dec )
1.1       noro     1359: {
                   1360:        register NODE nd, ans;
                   1361:
                   1362:        for ( ans = 0, nd = node; nd; nd = NEXT(nd) )
                   1363:                ans = NODE_sortbi_insert( (int) BDY(nd), ans, dec );
                   1364:        return ans;
                   1365: }
                   1366:
1.37      noro     1367: void reduceall(NODE in,NODE *h)
1.1       noro     1368: {
                   1369:        NODE r,t,top;
                   1370:        int n,i,j;
                   1371:        int *w;
                   1372:        DP g,g1;
                   1373:        struct oEGT tmp0,tmp1;
                   1374:
                   1375:        if ( NoRA ) {
                   1376:                *h = in; return;
                   1377:        }
1.12      noro     1378:        if ( DP_Print || DP_PrintShort ) {
1.1       noro     1379:                fprintf(asir_out,"reduceall\n"); fflush(asir_out);
                   1380:        }
                   1381:        r = NODE_sortbi(in,0);
                   1382:        n = length(r);
                   1383:        w = (int *)ALLOCA(n*sizeof(int));
                   1384:        for ( i = 0, t = r; i < n; i++, t = NEXT(t) )
                   1385:                w[i] = (int)BDY(t);
                   1386:        for ( i = 0; i < n; i++ ) {
                   1387:                for ( top = 0, j = n-1; j >= 0; j-- )
                   1388:                        if ( j != i ) {
                   1389:                                MKNODE(t,(pointer)w[j],top); top = t;
                   1390:                        }
                   1391:                get_eg(&tmp0);
                   1392:                dp_load(w[i],&ps[w[i]]);
                   1393:
1.7       noro     1394:                if ( GenTrace ) {
                   1395:                        Q q;
                   1396:                        NODE node;
                   1397:                        LIST hist;
                   1398:
                   1399:                        STOQ(w[i],q);
                   1400:                        node = mknode(4,ONE,q,ONE,ONE);
                   1401:                        MKLIST(hist,node);
                   1402:                        MKNODE(TraceList,hist,0);
                   1403:                }
1.16      noro     1404:                _dp_nf(top,ps[w[i]],ps,1,&g);
1.1       noro     1405:                prim_part(g,0,&g1);
                   1406:                get_eg(&tmp1); add_eg(&eg_ra,&tmp0,&tmp1);
1.12      noro     1407:                if ( DP_Print || DP_PrintShort ) {
1.1       noro     1408:                        fprintf(asir_out,"."); fflush(asir_out);
                   1409:                }
                   1410:                w[i] = newps(g1,0,(NODE)0);
                   1411:        }
                   1412:        for ( top = 0, j = n-1; j >= 0; j-- ) {
                   1413:                MKNODE(t,(pointer)w[j],top); top = t;
                   1414:        }
                   1415:        *h = top;
1.12      noro     1416:        if ( DP_Print || DP_PrintShort )
1.1       noro     1417:                fprintf(asir_out,"\n");
                   1418: }
                   1419:
1.37      noro     1420: void reduceall_mod(NODE in,int m,NODE *h)
1.1       noro     1421: {
                   1422:        NODE r,t,top;
                   1423:        int n,i,j;
                   1424:        int *w;
1.12      noro     1425:        DP g,p;
1.1       noro     1426:        struct oEGT tmp0,tmp1;
                   1427:
                   1428:        if ( NoRA ) {
                   1429:                *h = in; return;
                   1430:        }
1.12      noro     1431:        if ( DP_Print || DP_PrintShort ) {
1.1       noro     1432:                fprintf(asir_out,"reduceall\n"); fflush(asir_out);
                   1433:        }
                   1434:        r = NODE_sortbi(in,0);
                   1435:        n = length(r);
                   1436:        w = (int *)ALLOCA(n*sizeof(int));
                   1437:        for ( i = 0, t = r; i < n; i++, t = NEXT(t) )
                   1438:                w[i] = (int)BDY(t);
                   1439:        for ( i = 0; i < n; i++ ) {
                   1440:                for ( top = 0, j = n-1; j >= 0; j-- )
                   1441:                        if ( j != i ) {
                   1442:                                MKNODE(t,(pointer)w[j],top); top = t;
                   1443:                        }
                   1444:                get_eg(&tmp0);
                   1445:                if ( PCoeffs )
                   1446:                        dp_nf_mod(top,ps[w[i]],ps,m,1,&g);
1.12      noro     1447:                else {
                   1448:                        dpto_dp(ps[w[i]],&p);
                   1449:                        _dp_nf_mod_destructive(top,p,ps,m,1,&g);
                   1450:                }
1.1       noro     1451:                get_eg(&tmp1); add_eg(&eg_ra,&tmp0,&tmp1);
1.12      noro     1452:                if ( DP_Print || DP_PrintShort ) {
1.1       noro     1453:                        fprintf(asir_out,"."); fflush(asir_out);
                   1454:                }
                   1455:                w[i] = newps_mod(g,m);
                   1456:        }
                   1457:        for ( top = 0, j = n-1; j >= 0; j-- ) {
                   1458:                MKNODE(t,(pointer)w[j],top); top = t;
                   1459:        }
                   1460:        *h = top;
1.12      noro     1461:        if ( DP_Print || DP_PrintShort )
1.1       noro     1462:                fprintf(asir_out,"\n");
                   1463: }
                   1464:
1.37      noro     1465: int newps(DP a,int m,NODE subst)
1.1       noro     1466: {
                   1467:        if ( m && !validhc(!a?0:BDY(a)->c,m,subst) )
                   1468:                return -1;
                   1469:        if ( psn == pslen ) {
                   1470:                pslen *= 2;
                   1471:                ps = (DP *)REALLOC((char *)ps,pslen*sizeof(DP));
                   1472:                psh = (DL *)REALLOC((char *)psh,pslen*sizeof(DL));
                   1473:                pss = (int *)REALLOC((char *)pss,pslen*sizeof(int));
                   1474:                psc = (P *)REALLOC((char *)psc,pslen*sizeof(P));
                   1475:                if ( m )
                   1476:                        psm = (DP *)REALLOC((char *)psm,pslen*sizeof(DP));
                   1477:        }
                   1478:        if ( Demand ) {
                   1479:                if ( doing_f4 )
                   1480:                        ps[psn] = a;
                   1481:                else
                   1482:                        ps[psn] = 0;
1.7       noro     1483:                dp_save(psn,(Obj)a,0);
1.1       noro     1484:        } else
                   1485:                ps[psn] = a;
                   1486:        psh[psn] = BDY(a)->dl;
                   1487:        pss[psn] = a->sugar;
                   1488:        psc[psn] = BDY(a)->c;
                   1489:        if ( m )
                   1490:                _dp_mod(a,m,subst,&psm[psn]);
1.7       noro     1491:        if ( GenTrace ) {
                   1492:                NODE tn,tr,tr1;
1.23      noro     1493:                LIST trace,trace1;
                   1494:                NODE arg;
                   1495:                Q q1,q2;
                   1496:                STRING fname;
1.37      noro     1497:                Obj obj;
1.7       noro     1498:
                   1499:                /* reverse the TraceList */
                   1500:                tn = TraceList;
                   1501:                for ( tr = 0; tn; tn = NEXT(tn) ) {
                   1502:                        MKNODE(tr1,BDY(tn),tr); tr = tr1;
                   1503:                }
                   1504:                MKLIST(trace,tr);
                   1505:                if ( OXCheck >= 0 ) {
                   1506:                        STOQ(OXCheck,q1);
                   1507:                        MKSTR(fname,"check_trace");
                   1508:                        STOQ(psn,q2);
                   1509:                        arg = mknode(5,q1,fname,a,q2,trace);
1.37      noro     1510:                        Pox_cmo_rpc(arg,&obj);
1.23      noro     1511:                } else if ( OXCheck < 0 ) {
                   1512:                        STOQ(psn,q1);
                   1513:                        tn = mknode(2,q1,trace);
                   1514:                        MKLIST(trace1,tn);
                   1515:                        MKNODE(tr,trace1,AllTraceList);
                   1516:                        AllTraceList = tr;
1.7       noro     1517:                } else
                   1518:                        dp_save(psn,(Obj)trace,"t");
                   1519:                TraceList = 0;
                   1520:        }
1.1       noro     1521:        return psn++;
                   1522: }
                   1523:
1.37      noro     1524: int newps_nosave(DP a,int m,NODE subst)
1.1       noro     1525: {
                   1526:        if ( m && !validhc(!a?0:BDY(a)->c,m,subst) )
                   1527:                return -1;
                   1528:        if ( psn == pslen ) {
                   1529:                pslen *= 2;
                   1530:                ps = (DP *)REALLOC((char *)ps,pslen*sizeof(DP));
                   1531:                psh = (DL *)REALLOC((char *)psh,pslen*sizeof(DL));
                   1532:                pss = (int *)REALLOC((char *)pss,pslen*sizeof(int));
                   1533:                psc = (P *)REALLOC((char *)psc,pslen*sizeof(P));
                   1534:                if ( m )
                   1535:                        psm = (DP *)REALLOC((char *)psm,pslen*sizeof(DP));
                   1536:        }
                   1537:        ps[psn] = 0;
                   1538:        psh[psn] = BDY(a)->dl;
                   1539:        pss[psn] = a->sugar;
                   1540:        psc[psn] = BDY(a)->c;
                   1541:        if ( m )
                   1542:                _dp_mod(a,m,subst,&psm[psn]);
                   1543:        return psn++;
                   1544: }
                   1545:
1.37      noro     1546: int newps_mod(DP a,int m)
1.1       noro     1547: {
                   1548:        if ( psn == pslen ) {
                   1549:                pslen *= 2;
                   1550:                ps = (DP *)REALLOC((char *)ps,pslen*sizeof(DP));
                   1551:                psh = (DL *)REALLOC((char *)psh,pslen*sizeof(DL));
                   1552:                pss = (int *)REALLOC((char *)pss,pslen*sizeof(int));
                   1553:                psc = (P *)REALLOC((char *)psc,pslen*sizeof(P)); /* XXX */
                   1554:        }
                   1555:        ps[psn] = a;
                   1556:        psh[psn] = BDY(ps[psn])->dl;
                   1557:        pss[psn] = ps[psn]->sugar;
                   1558:        return psn++;
                   1559: }
                   1560:
1.37      noro     1561: void reducebase_dehomo(NODE f,NODE *g)
1.1       noro     1562: {
                   1563:        int n,i,j,k;
                   1564:        int *r;
                   1565:        DL *w,d;
                   1566:        DP u;
                   1567:        NODE t,top;
                   1568:
                   1569:        n = length(f);
                   1570:        w = (DL *)ALLOCA(n*sizeof(DL));
                   1571:        r = (int *)ALLOCA(n*sizeof(int));
                   1572:        for ( i = 0, t = f; i < n; i++, t = NEXT(t) ) {
                   1573:                r[i] = (int)BDY(t); w[i] = psh[r[i]];
                   1574:        }
                   1575:        for ( i = 0; i < n; i++ ) {
                   1576:                for ( j = 0, d = w[i]; j < n; j++ ) {
                   1577:                        if ( j != i ) {
                   1578:                                for ( k = 0; k < NVars; k++ )
                   1579:                                        if ( d->d[k] < w[j]->d[k] )
                   1580:                                                break;
                   1581:                                if ( k == NVars )
                   1582:                                        break;
                   1583:                        }
                   1584:                }
                   1585:                if ( j != n )
                   1586:                        r[i] = -1;
                   1587:        }
                   1588:        for ( top = 0, i = n-1; i >= 0; i-- )
                   1589:                if ( r[i] >= 0 ) {
1.7       noro     1590:                        dp_load(r[i],&ps[r[i]]); dp_dehomo(ps[r[i]],&u);
                   1591:                        if ( GenTrace ) {
                   1592:                                Q q;
                   1593:                                LIST hist;
                   1594:                                NODE node;
                   1595:
                   1596:                                STOQ(r[i],q);
                   1597:                                node = mknode(4,0,q,0,0);
                   1598:                                MKLIST(hist,node);
                   1599:                                MKNODE(TraceList,hist,0);
                   1600:                        }
                   1601:                        j = newps(u,0,0);
1.1       noro     1602:                        MKNODE(t,j,top); top = t;
                   1603:                }
                   1604:        *g = top;
                   1605: }
                   1606:
1.37      noro     1607: NODE append_one(NODE f,int n)
1.1       noro     1608: {
                   1609:        NODE t;
                   1610:
                   1611:        if ( Reverse || !f ) {
                   1612:                MKNODE(t,(pointer)n,f); return t;
                   1613:        } else {
                   1614:                for ( t = f; NEXT(t); t = NEXT(t) );
                   1615:                MKNODE(NEXT(t),(pointer)n,0);
                   1616:                return f;
                   1617:        }
                   1618: }
                   1619:
1.37      noro     1620: DP_pairs minp( DP_pairs d, DP_pairs *prest )
1.1       noro     1621: {
                   1622:        register DP_pairs m, ml, p, l;
                   1623:        register DL lcm;
                   1624:        register int s, nv = CNVars;
                   1625:        register int (*cmpfun)() = cmpdl;
                   1626:
                   1627:        if ( !(p = NEXT(m = d)) ) {
                   1628:                *prest = p;
                   1629:                NEXT(m) = 0;
                   1630:                return m;
                   1631:        }
                   1632:        for ( lcm = m->lcm, s = m->sugar, ml = 0, l = m; p; p = NEXT(l = p) )
                   1633:                if ( NoSugar ? (*cmpfun)( nv, lcm, p->lcm ) >= 0 :
                   1634:                     (s > p->sugar || s == p->sugar && (*cmpfun)( nv, lcm, p->lcm ) >= 0) )
                   1635:                        ml = l,  lcm = (m = p)->lcm,  s = p->sugar;
                   1636:        if ( !ml ) *prest = NEXT(m);
                   1637:        else {
                   1638:                NEXT(ml) = NEXT(m);
                   1639:                *prest = d;
                   1640:        }
                   1641:        NEXT(m) = 0;
                   1642:        return m;
                   1643: }
                   1644:
1.37      noro     1645: void minsugar(DP_pairs d,DP_pairs *dm,DP_pairs *dr)
1.1       noro     1646: {
                   1647:        int msugar;
                   1648:        DP_pairs t,dm0,dr0,dmt,drt;
                   1649:
                   1650:        for ( msugar = d->sugar, t = NEXT(d); t; t = NEXT(t) )
                   1651:                if ( t->sugar < msugar )
                   1652:                        msugar = t->sugar;
                   1653:        dm0 = 0; dr0 = 0;
                   1654:        for ( t = d; t; t = NEXT(t) ) {
                   1655:                if ( t->sugar == msugar ) {
                   1656:                        NEXTDPP(dm0,dmt);
                   1657:                        dmt->dp1 = t->dp1; dmt->dp2 = t->dp2;
                   1658:                        dmt->lcm = t->lcm; dmt->sugar = t->sugar;
                   1659:                } else {
                   1660:                        NEXTDPP(dr0,drt);
                   1661:                        drt->dp1 = t->dp1; drt->dp2 = t->dp2;
                   1662:                        drt->lcm = t->lcm; drt->sugar = t->sugar;
                   1663:                }
                   1664:        }
                   1665:        if ( dm0 ) NEXT(dmt) = 0;
                   1666:        if ( dr0 ) NEXT(drt) = 0;
                   1667:        *dm = dm0; *dr = dr0;
                   1668: }
                   1669:
1.37      noro     1670: NODE gb(NODE f,int m,NODE subst)
1.1       noro     1671: {
1.42      noro     1672:        int i,nh,prev,mag,mag0,magt;
1.1       noro     1673:        NODE r,g,gall;
1.37      noro     1674:        DP_pairs d;
1.1       noro     1675:        DP_pairs l;
                   1676:        DP h,nf,nfm,dp1,dp2;
                   1677:        MP mp;
1.37      noro     1678:        struct oEGT tnf0,tnf1,tnfm0,tnfm1,tpz0,tpz1,tnp0,tnp1;
1.1       noro     1679:        int skip_nf_flag;
                   1680:        double t_0;
1.7       noro     1681:        Q q;
1.6       noro     1682:        int new_sugar;
1.1       noro     1683:        static prev_sugar = -1;
                   1684:
                   1685:        Max_mag = 0;
1.42      noro     1686:        Max_coef = 0;
1.1       noro     1687:        prev = 1;
                   1688:        doing_f4 = 0;
                   1689:        if ( m ) {
                   1690:                psm = (DP *)MALLOC(pslen*sizeof(DP));
                   1691:                for ( i = 0; i < psn; i++ )
                   1692:                        if ( psh[i] && !validhc(psc[i],m,subst) )
                   1693:                                return 0;
                   1694:                        else
                   1695:                                _dp_mod(ps[i],m,subst,&psm[i]);
                   1696:        }
                   1697:        for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
                   1698:                i = (int)BDY(r);
                   1699:                d = updpairs(d,g,i);
                   1700:                g = updbase(g,i);
                   1701:                gall = append_one(gall,i);
                   1702:        }
                   1703:        while ( d ) {
1.14      noro     1704:                l = minp(d,&d);
1.1       noro     1705:                if ( m ) {
1.6       noro     1706:                        _dp_sp_mod_dup(psm[l->dp1],psm[l->dp2],m,&h);
1.10      noro     1707:                        if ( h )
                   1708:                                new_sugar = h->sugar;
1.1       noro     1709:                        get_eg(&tnfm0);
1.6       noro     1710:                        _dp_nf_mod_destructive(gall,h,psm,m,0,&nfm);
1.1       noro     1711:                        get_eg(&tnfm1); add_eg(&eg_nfm,&tnfm0,&tnfm1);
                   1712:                } else
                   1713:                        nfm = (DP)1;
                   1714:                if ( nfm ) {
                   1715:                        if ( Demand ) {
                   1716:                                if ( dp_load_t(psn,&nf) ) {
                   1717:                                        skip_nf_flag = 1;
                   1718:                                        goto skip_nf;
                   1719:                                } else {
                   1720:                                        skip_nf_flag = 0;
                   1721:                                        dp_load(l->dp1,&dp1); dp_load(l->dp2,&dp2);
                   1722:                                        dp_sp(dp1,dp2,&h);
                   1723:                                }
                   1724:                        } else
                   1725:                                dp_sp(ps[l->dp1],ps[l->dp2],&h);
1.7       noro     1726:                        if ( GenTrace ) {
                   1727:                                STOQ(l->dp1,q); ARG1(BDY((LIST)BDY(NEXT(TraceList)))) = q;
                   1728:                                STOQ(l->dp2,q); ARG1(BDY((LIST)BDY(TraceList))) = q;
                   1729:                        }
1.10      noro     1730:                        if ( h )
                   1731:                                new_sugar = h->sugar;
1.1       noro     1732:                        get_eg(&tnf0);
                   1733:                        t_0 = get_rtime();
1.18      noro     1734:                        if ( PCoeffs || dp_fcoeffs )
1.16      noro     1735:                                _dp_nf(gall,h,ps,!Top,&nf);
                   1736:                        else
1.21      noro     1737:                                _dp_nf_z(gall,h,ps,!Top,DP_Multiple,&nf);
1.50      noro     1738:                        if ( DP_Print && nf )
1.1       noro     1739:                                fprintf(asir_out,"(%.3g)",get_rtime()-t_0);
                   1740:                        get_eg(&tnf1); add_eg(&eg_nf,&tnf0,&tnf1);
                   1741:                } else
                   1742:                        nf = 0;
                   1743: skip_nf:
                   1744:                if ( nf ) {
                   1745:                        NZR++;
                   1746:                        get_eg(&tpz0);
                   1747:                        prim_part(nf,0,&h);
                   1748:                        get_eg(&tpz1); add_eg(&eg_pz,&tpz0,&tpz1);
                   1749:                        get_eg(&tnp0);
                   1750:                        if ( Demand && skip_nf_flag )
                   1751:                                nh = newps_nosave(h,m,subst);
                   1752:                        else
                   1753:                                nh = newps(h,m,subst);
                   1754:                        get_eg(&tnp1); add_eg(&eg_np,&tnp0,&tnp1);
                   1755:                        if ( nh < 0 )
                   1756:                                return 0;
                   1757:                        d = updpairs(d,g,nh);
                   1758:                        g = updbase(g,nh);
                   1759:                        gall = append_one(gall,nh);
                   1760:                        if ( !dp_fcoeffs && ShowMag ) {
1.42      noro     1761:                                for ( mag = 0, mag0 = 0, mp = BDY(h); mp; mp = NEXT(mp) ) {
                   1762:                                        magt = p_mag((P)mp->c);
                   1763:                                        mag0 = MAX(mag0,magt);
                   1764:                                        mag += magt;
                   1765:                                }
                   1766:                                Max_coef = MAX(Max_coef,mag0);
1.1       noro     1767:                                Max_mag = MAX(Max_mag,mag);
                   1768:                        }
1.12      noro     1769:                        if ( DP_Print ) {
1.1       noro     1770:                                if ( !prev )
                   1771:                                        fprintf(asir_out,"\n");
                   1772:                                print_split_e(&tnf0,&tnf1); print_split_e(&tpz0,&tpz1);
                   1773:                                printdl(psh[nh]);
                   1774:                                fprintf(asir_out,"(%d,%d),nb=%d,nab=%d,rp=%d,sugar=%d",
                   1775:                                        l->dp1,l->dp2,length(g),length(gall),DPPlength(d),
                   1776:                                        pss[nh]);
                   1777:                                if ( ShowMag )
1.42      noro     1778:                                        fprintf(asir_out,",mag=(%d,%d)",mag,mag0);
1.1       noro     1779:                                fprintf(asir_out,"\n"); fflush(asir_out);
1.12      noro     1780:                        } else if ( DP_PrintShort ) {
1.1       noro     1781:                                fprintf(asir_out,"+"); fflush(asir_out);
                   1782:                        }
                   1783:                        prev = 1;
                   1784:                } else {
                   1785:                        if ( m )
                   1786:                                add_eg(&eg_znfm,&tnfm0,&tnfm1);
                   1787:                        ZR++;
1.12      noro     1788:                        if ( DP_Print || DP_PrintShort ) {
1.6       noro     1789:                                if ( new_sugar != prev_sugar ) {
                   1790:                                        fprintf(asir_out,"[%d]",new_sugar);
                   1791:                                        prev_sugar = new_sugar;
1.1       noro     1792:                                }
                   1793:                                fprintf(asir_out,"."); fflush(asir_out); prev = 0;
                   1794:                        }
                   1795:                }
                   1796:        }
1.12      noro     1797:        if ( DP_Print || DP_PrintShort )
1.1       noro     1798:                fprintf(asir_out,"gb done\n");
                   1799:        return g;
                   1800: }
                   1801:
1.37      noro     1802: NODE gb_mod(NODE f,int m)
1.1       noro     1803: {
                   1804:        int i,nh,prev;
                   1805:        NODE r,g,gall;
1.37      noro     1806:        DP_pairs d;
1.1       noro     1807:        DP_pairs l;
                   1808:        DP h,nf;
1.37      noro     1809:        struct oEGT tnfm0,tnfm1,tpz0,tpz1;
1.1       noro     1810:
                   1811:        prev = 1;
                   1812:        for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
                   1813:                i = (int)BDY(r);
                   1814:                d = updpairs(d,g,i);
                   1815:                g = updbase(g,i);
                   1816:                gall = append_one(gall,i);
                   1817:        }
                   1818:        while ( d ) {
1.14      noro     1819:                l = minp(d,&d);
1.1       noro     1820:                if ( PCoeffs ) {
                   1821:                        dp_sp_mod(ps[l->dp1],ps[l->dp2],m,&h);
1.14      noro     1822:                        get_eg(&tnfm0);
1.1       noro     1823:                        dp_nf_mod(gall,h,ps,m,!Top,&nf);
                   1824:                } else {
1.6       noro     1825:                        _dp_sp_mod_dup(ps[l->dp1],ps[l->dp2],m,&h);
1.14      noro     1826:                        get_eg(&tnfm0);
1.6       noro     1827:                        _dp_nf_mod_destructive(gall,h,ps,m,!Top,&nf);
1.1       noro     1828:                }
                   1829:                get_eg(&tnfm1); add_eg(&eg_nfm,&tnfm0,&tnfm1);
                   1830:                if ( nf ) {
                   1831:                        NZR++;
                   1832:                        get_eg(&tpz0);
                   1833:                        prim_part(nf,m,&h);
                   1834:                        get_eg(&tpz1); add_eg(&eg_pz,&tpz0,&tpz1);
                   1835:                        nh = newps_mod(h,m);
                   1836:                        if ( nh < 0 )
                   1837:                                return 0;
                   1838:                        d = updpairs(d,g,nh);
                   1839:                        g = updbase(g,nh);
                   1840:                        gall = append_one(gall,nh);
1.12      noro     1841:                        if ( DP_Print ) {
1.1       noro     1842:                                if ( !prev )
                   1843:                                        fprintf(asir_out,"\n");
                   1844:                                print_split_eg(&tnfm0,&tnfm1); fflush(asir_out);
                   1845:                                fprintf(asir_out,"(%d,%d),nb=%d,nab=%d,rp=%d,sugar=%d",l->dp1,l->dp2,length(g),length(gall),DPPlength(d),pss[nh]);
                   1846:                                printdl(psh[nh]); fprintf(asir_out,"\n"); fflush(asir_out);
1.12      noro     1847:                        } else if ( DP_PrintShort ) {
1.6       noro     1848:                                fprintf(asir_out,"+"); fflush(asir_out);
1.1       noro     1849:                        }
                   1850:                        prev = 1;
                   1851:                } else {
                   1852:                        add_eg(&eg_znfm,&tnfm0,&tnfm1);
                   1853:                        ZR++;
1.12      noro     1854:                        if ( DP_Print || DP_PrintShort ) {
1.1       noro     1855:                                fprintf(asir_out,"."); fflush(asir_out); prev = 0;
                   1856:                        }
                   1857:                }
                   1858:        }
1.12      noro     1859:        if ( DP_Print || DP_PrintShort )
1.1       noro     1860:                fprintf(asir_out,"gb_mod done\n");
                   1861:        return g;
                   1862: }
                   1863:
1.37      noro     1864: DP_pairs updpairs( DP_pairs d, NODE /* of index */ g, int t)
1.1       noro     1865: {
1.14      noro     1866:        register DP_pairs d1, dd, nd;
                   1867:        int dl,dl1;
1.1       noro     1868:
1.14      noro     1869:        if ( !g ) return d;
                   1870:        if ( !NoCriB && d ) {
                   1871:                dl = DPPlength(d);
                   1872:                d = criterion_B( d, t );
                   1873:                dl -= DPPlength(d); NBP += dl;
1.1       noro     1874:        }
1.14      noro     1875:        d1 = newpairs( g, t );
                   1876:        if ( NEXT(d1) ) {
                   1877:                dl = DPPlength(d1); TP += dl;
                   1878:                d1 = criterion_M( d1 );
                   1879:                dl1 = DPPlength(d1); NMP += (dl-dl1); dl = dl1;
                   1880:                d1 = criterion_F( d1 );
                   1881:                dl1 = DPPlength(d1); NFP += (dl-dl1); dl = dl1;
                   1882:        } else
                   1883:                dl = 1;
                   1884:        if ( !do_weyl )
                   1885:                for ( dd = 0; d1; d1 = nd ) {
                   1886:                        nd = NEXT(d1);
                   1887:                        if ( !criterion_2( d1->dp1, d1->dp2 ) ) {
                   1888:                                NEXT(d1) = dd;
                   1889:                                dd = d1;
1.1       noro     1890:                        }
                   1891:                }
1.14      noro     1892:        else
                   1893:                dd = d1;
                   1894:        dl1 = DPPlength(dd); NDP += (dl-dl1);
                   1895:        if ( !(nd = d) ) return dd;
                   1896:        while ( nd = NEXT(d1 = nd) ) ;
                   1897:        NEXT(d1) = dd;
                   1898:        return d;
1.1       noro     1899: }
                   1900:
1.37      noro     1901: DP_pairs newpairs( NODE /* of index */ g, int t )
1.14      noro     1902: {
                   1903:        register NODE r;
                   1904:        register DL tdl = psh[t];
                   1905:        register int ts;
                   1906:        register DP_pairs p, last;
                   1907:        int dp;
                   1908:        register DL dl;
                   1909:        register int s;
1.1       noro     1910:
1.14      noro     1911:        ts = pss[t] - tdl->td;
                   1912:        for ( last = 0, r = g; r; r = NEXT(r) ) {
                   1913:                NEXT(p = NEWDP_pairs) = last;
                   1914:                last = p;
                   1915:                dp = p->dp1 = (int)BDY(r);  p->dp2 = t;
                   1916:                p->lcm = lcm_of_DL(CNVars, dl = psh[dp], tdl, (DL)0 );
                   1917: #if 0
                   1918:                if ( do_weyl )
1.41      noro     1919:                        p->sugar = dl_weyl_weight(p->lcm);
1.14      noro     1920:                else
                   1921: #endif
                   1922:                        p->sugar = (ts > (s = pss[dp] - dl->td) ? ts : s) + p->lcm->td;
                   1923:        }
                   1924:        return last;
                   1925: }
1.1       noro     1926:
1.37      noro     1927: DP_pairs criterion_B( DP_pairs d, int s )
1.1       noro     1928: {
1.14      noro     1929:        register DP_pairs dd, p;
                   1930:        register DL tij, t = psh[s], dltmp;
1.1       noro     1931:
1.14      noro     1932:        if ( !d ) return 0;
                   1933:        NEWDL( dltmp, CNVars );
                   1934:        for ( dd = 0; d; d = p ) {
                   1935:                p = NEXT(d),
                   1936:                tij = d->lcm;
                   1937:                if ( tij->td != lcm_of_DL(CNVars, tij, t, dltmp )->td
                   1938:                        || !dl_equal(CNVars, tij, dltmp )
                   1939:                        || (tij->td == lcm_of_DL(CNVars, psh[d->dp1], t, dltmp )->td
                   1940:                            && dl_equal(CNVars, dltmp, tij ))
                   1941:                        || (tij->td == lcm_of_DL(CNVars, psh[d->dp2], t, dltmp )->td
                   1942:                            && dl_equal(CNVars, dltmp, tij )) ) {
                   1943:                        NEXT(d) = dd;
                   1944:                        dd = d;
                   1945:                }
1.1       noro     1946:        }
1.14      noro     1947:        return dd;
                   1948: }
1.1       noro     1949:
1.37      noro     1950: DP_pairs criterion_M( DP_pairs d1 )
1.14      noro     1951: {
                   1952:        register DP_pairs dd, e, d3, d2, p;
                   1953:        register DL itdl, jtdl;
                   1954:        register int itdltd, jtdltd;
1.1       noro     1955:
1.14      noro     1956:        for ( dd = 0, e = d1; e; e = d3 ) {
                   1957:                if ( !(d2 = NEXT(e)) ) {
                   1958:                        NEXT(e) = dd;
                   1959:                        return e;
                   1960:                }
                   1961:                itdltd = (itdl = e->lcm)->td;
                   1962:                for ( d3 = 0; d2; d2 = p ) {
                   1963:                        p = NEXT(d2),
                   1964:                        jtdltd = (jtdl = d2->lcm)->td;
                   1965:                        if ( jtdltd == itdltd  )
                   1966:                                if ( dl_equal(CNVars, itdl, jtdl ) ) ;
                   1967:                                else if ( dl_redble( jtdl, itdl ) ) continue;
                   1968:                                else if ( dl_redble( itdl, jtdl ) ) goto delit;
                   1969:                                else ;
                   1970:                        else if ( jtdltd > itdltd )
                   1971:                                if ( dl_redble( jtdl, itdl ) ) continue;
1.1       noro     1972:                                else ;
                   1973:                        else if ( dl_redble( itdl, jtdl ) ) goto delit;
                   1974:                        NEXT(d2) = d3;
                   1975:                        d3 = d2;
                   1976:                }
                   1977:                NEXT(e) = dd;
                   1978:                dd = e;
                   1979:                continue;
                   1980:                /**/
                   1981:        delit:  NEXT(d2) = d3;
                   1982:                d3 = d2;
                   1983:                for ( ; p; p = d2 ) {
                   1984:                        d2 = NEXT(p);
                   1985:                        NEXT(p) = d3;
                   1986:                        d3 = p;
                   1987:                }
                   1988:        }
                   1989:        return dd;
                   1990: }
                   1991:
1.37      noro     1992: static DP_pairs collect_pairs_of_hdlcm( DP_pairs d1, DP_pairs *prest )
1.1       noro     1993: {
                   1994:        register DP_pairs w, p, r, s;
                   1995:        register DL ti;
                   1996:        register int td;
                   1997:
                   1998:        td = (ti = (w = d1)->lcm)->td;
                   1999:        s = NEXT(w);
                   2000:        NEXT(w) = 0;
                   2001:        for ( r = 0; s; s = p ) {
                   2002:                p = NEXT(s);
                   2003:                if ( td == s->lcm->td && dl_equal(CNVars, ti, s->lcm ) )
                   2004:                {
                   2005:                        NEXT(s) = w;
                   2006:                        w = s;
                   2007:                } else {
                   2008:                        NEXT(s) = r;
                   2009:                        r = s;
                   2010:                }
                   2011:        }
                   2012:        *prest = r;
                   2013:        return w;
                   2014: }
                   2015:
1.37      noro     2016: int criterion_2( int dp1, int dp2 )
1.1       noro     2017: {
                   2018:        register int i, *d1, *d2;
                   2019:
                   2020:        d1 = psh[dp1]->d,  d2 = psh[dp2]->d;
                   2021:        for ( i = CNVars; --i >= 0; d1++, d2++ )
                   2022:                if ( (*d1 <= *d2 ? *d1 : *d2) > 0  ) return 0;
                   2023:        return 1;
                   2024: }
                   2025:
1.37      noro     2026: DP_pairs criterion_F( DP_pairs d1 )
1.1       noro     2027: {
                   2028:        DP_pairs rest, head;
                   2029:        register DP_pairs last, p, r, w;
                   2030:        register int s;
                   2031:
                   2032:        for ( head = last = 0, p = d1; NEXT(p); ) {
                   2033:                s = (r = w = collect_pairs_of_hdlcm( p, &rest ))->sugar;
                   2034:                while ( w = NEXT(w) )
1.52      noro     2035:                        if ( !do_weyl && criterion_2( w->dp1, w->dp2 ) ) {
1.1       noro     2036:                                r = w;
                   2037:                                break;
                   2038:                        } else if ( w->sugar < s ) s = (r = w)->sugar;
                   2039:                if ( last ) NEXT(last) = r;
                   2040:                else head = r;
                   2041:                NEXT(last = r) = 0;
                   2042:                if ( !(p = rest) ) return head;
                   2043:        }
                   2044:        if ( !last ) return p;
                   2045:        NEXT(last) = p;
                   2046:        return head;
                   2047: }
                   2048:
1.37      noro     2049: NODE updbase(NODE g,int t)
1.1       noro     2050: {
                   2051:        g = remove_reducibles(g,t);
                   2052:        g = append_one(g,t);
                   2053:        return g;
                   2054: }
                   2055:
1.37      noro     2056: NODE /* of index */ remove_reducibles(NODE /* of index */ nd, int newdp )
1.1       noro     2057: {
                   2058:        register DL dl, dln;
                   2059:        register NODE last, p, head;
                   2060:        register int td;
                   2061:
                   2062:        dl = psh[newdp];
                   2063:        td = dl->td;
                   2064:        for ( head = last = 0, p = nd; p; ) {
                   2065:                dln = psh[(int)BDY(p)];
                   2066:                if ( dln->td >= td && dl_redble( dln, dl ) ) {
                   2067:                        p = NEXT(p);
                   2068:                        if ( last ) NEXT(last) = p;
                   2069:                } else {
                   2070:                        if ( !last ) head = p;
                   2071:                        p = NEXT(last = p);
                   2072:                }
                   2073:        }
                   2074:        return head;
                   2075: }
                   2076:
1.37      noro     2077: int dl_redble(DL dl1,DL dl2)
1.1       noro     2078: {
                   2079:        register int n, *d1, *d2;
                   2080:
                   2081:        for ( d1 = dl1->d, d2 = dl2->d, n = CNVars; --n >= 0; d1++, d2++ )
                   2082:                if ( *d1 < *d2 ) return 0;
                   2083:        return 1;
1.5       noro     2084: }
                   2085:
1.41      noro     2086: #if 0
                   2087: int dl_weyl_weight(DL dl)
1.5       noro     2088: {
                   2089:        int n,w,i;
                   2090:
                   2091:        n = CNVars/2;
                   2092:        for ( i = 0, w = 0; i < n; i++ )
                   2093:                w += (-dl->d[i]+dl->d[n+i]);
                   2094:        return w;
1.1       noro     2095: }
1.41      noro     2096: #endif
1.1       noro     2097:
1.37      noro     2098: int gbcheck(NODE f)
1.1       noro     2099: {
                   2100:        int i;
                   2101:        NODE r,g,gall;
                   2102:        DP_pairs d,l;
                   2103:        DP h,nf,dp1,dp2;
                   2104:        struct oEGT tmp0,tmp1;
                   2105:
                   2106:        if ( NoGC )
                   2107:                return 1;
                   2108:        for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
                   2109:                i = (int)BDY(r);
                   2110:                d = updpairs(d,g,i);
                   2111:                g = updbase(g,i);
                   2112:                gall = append_one(gall,i);
                   2113:        }
1.12      noro     2114:        if ( DP_Print || DP_PrintShort ) {
1.1       noro     2115:                fprintf(asir_out,"gbcheck total %d pairs\n",DPPlength(d)); fflush(asir_out);
                   2116:        }
                   2117:        while ( d ) {
                   2118:                l = d; d = NEXT(d);
                   2119:                get_eg(&tmp0);
1.17      noro     2120:                dp_load(l->dp1,&dp1); dp_load(l->dp2,&dp2);
                   2121:                dp_sp(dp1,dp2,&h);
                   2122: /* fprintf(stderr,"{%d,%d}",l->dp1,l->dp2); */
1.16      noro     2123:                _dp_nf(gall,h,ps,1,&nf);
1.1       noro     2124:                get_eg(&tmp1); add_eg(&eg_gc,&tmp0,&tmp1);
1.12      noro     2125:                if ( DP_Print || DP_PrintShort ) {
1.1       noro     2126:                        fprintf(asir_out,"."); fflush(asir_out);
                   2127:                }
                   2128:                if ( nf )
                   2129:                        return 0;
                   2130:        }
1.12      noro     2131:        if ( DP_Print || DP_PrintShort )
1.1       noro     2132:                fprintf(asir_out,"\n");
                   2133:        return 1;
1.38      noro     2134: }
                   2135:
1.40      noro     2136: void gbcheck_list(NODE f,int n,VECT *gp,LIST *pp)
1.38      noro     2137: {
                   2138:        int i;
                   2139:        NODE r,g,gall,u,u0,t;
1.39      noro     2140:        VECT vect;
1.38      noro     2141:        LIST pair;
                   2142:        DP_pairs d,l;
                   2143:        Q q1,q2;
                   2144:
1.40      noro     2145:        /* we need the following settings */
                   2146:        NVars = CNVars = n;
1.39      noro     2147:        setup_arrays(f,0,&r);
                   2148:        for ( gall = g = 0, d = 0; r; r = NEXT(r) ) {
1.38      noro     2149:                i = (int)BDY(r);
                   2150:                d = updpairs(d,g,i);
                   2151:                g = updbase(g,i);
                   2152:                gall = append_one(gall,i);
                   2153:        }
1.39      noro     2154:        NEWVECT(vect); vect->len = psn; vect->body = (pointer)ps;
                   2155:        *gp = vect;
                   2156:
1.38      noro     2157:        for ( u0 = 0, l = d; l; l = NEXT(l) ) {
                   2158:                NEXTNODE(u0,u);
                   2159:                STOQ(l->dp1,q1);
                   2160:                STOQ(l->dp2,q2);
                   2161:                t = mknode(2,q1,q2);
                   2162:                MKLIST(pair,t);
                   2163:                BDY(u) = (pointer)pair;
                   2164:        }
                   2165:        if ( u0 )
                   2166:                NEXT(u) = 0;
1.39      noro     2167:        MKLIST(*pp,u0);
1.1       noro     2168: }
                   2169:
1.37      noro     2170: int membercheck(NODE f,NODE x)
1.1       noro     2171: {
                   2172:        DP g;
                   2173:        struct oEGT tmp0,tmp1;
                   2174:
                   2175:        if ( NoMC )
                   2176:                return 1;
1.12      noro     2177:        if ( DP_Print || DP_PrintShort ) {
1.1       noro     2178:                fprintf(asir_out,"membercheck\n"); fflush(asir_out);
                   2179:        }
                   2180:        for ( ; f; f = NEXT(f) ) {
                   2181:                get_eg(&tmp0);
1.16      noro     2182:                _dp_nf(x,(DP)BDY(f),ps,1,&g);
1.1       noro     2183:                get_eg(&tmp1); add_eg(&eg_mc,&tmp0,&tmp1);
1.12      noro     2184:                if ( DP_Print ) {
1.1       noro     2185:                        print_split_eg(&tmp0,&tmp1); fflush(asir_out);
1.12      noro     2186:                } else if ( DP_PrintShort ) {
1.1       noro     2187:                        fprintf(asir_out,"."); fflush(asir_out);
                   2188:                }
                   2189:                if ( g )
                   2190:                        return 0;
                   2191:        }
1.12      noro     2192:        if ( DP_Print || DP_PrintShort )
1.1       noro     2193:                fprintf(asir_out,"\n");
                   2194:        return 1;
                   2195: }
                   2196:
1.37      noro     2197: void dp_set_flag(Obj name,Obj value)
1.1       noro     2198: {
                   2199:        char *n;
                   2200:        int v;
1.43      noro     2201:        Q ratio;
1.1       noro     2202:
                   2203:        if ( OID(name) != O_STR )
                   2204:                return;
                   2205:        n = BDY((STRING)name);
                   2206:        if ( !strcmp(n,"Demand") ) {
                   2207:                Demand = value ? BDY((STRING)value) : 0; return;
                   2208:        }
                   2209:        if ( !strcmp(n,"Dist") ) {
                   2210:                Dist = (LIST)value; return;
                   2211:        }
1.43      noro     2212:        if ( !strcmp(n,"Content") ) {
                   2213:                ratio = (Q)value;
                   2214:                if ( ratio ) {
                   2215:                        DP_Multiple = BD(NM(ratio))[0];
                   2216:                        Denominator = INT(ratio) ? 1 : BD(DN(ratio))[0];
                   2217:                } else {
                   2218:                        DP_Multiple = 0;
                   2219:                        Denominator = 1;
                   2220:                }
                   2221:        }
1.1       noro     2222:        if ( value && OID(value) != O_N )
                   2223:                return;
                   2224:        v = QTOS((Q)value);
                   2225:        if ( !strcmp(n,"NoSugar") )
                   2226:                NoSugar = v;
                   2227:        else if ( !strcmp(n,"NoCriB") )
                   2228:                NoCriB = v;
                   2229:        else if ( !strcmp(n,"NoGC") )
                   2230:                NoGC = v;
                   2231:        else if ( !strcmp(n,"NoMC") )
                   2232:                NoMC = v;
                   2233:        else if ( !strcmp(n,"NoRA") )
                   2234:                NoRA = v;
                   2235:        else if ( !strcmp(n,"NoGCD") )
                   2236:                NoGCD = v;
                   2237:        else if ( !strcmp(n,"Top") )
                   2238:                Top = v;
                   2239:        else if ( !strcmp(n,"ShowMag") )
                   2240:                ShowMag = v;
1.14      noro     2241:        else if ( !strcmp(n,"PrintShort") )
1.12      noro     2242:                DP_PrintShort = v;
1.14      noro     2243:        else if ( !strcmp(n,"Print") )
1.12      noro     2244:                DP_Print = v;
1.14      noro     2245:        else if ( !strcmp(n,"NFStat") )
                   2246:                DP_NFStat = v;
1.1       noro     2247:        else if ( !strcmp(n,"Stat") )
                   2248:                Stat = v;
                   2249:        else if ( !strcmp(n,"Reverse") )
                   2250:                Reverse = v;
                   2251:        else if ( !strcmp(n,"Multiple") )
1.14      noro     2252:                DP_Multiple = v;
1.1       noro     2253:        else if ( !strcmp(n,"Denominator") )
                   2254:                Denominator = v;
                   2255:        else if ( !strcmp(n,"PtozpRA") )
                   2256:                PtozpRA = v;
1.7       noro     2257:        else if ( !strcmp(n,"GenTrace") )
                   2258:                GenTrace = v;
                   2259:        else if ( !strcmp(n,"OXCheck") )
                   2260:                OXCheck = v;
1.1       noro     2261: }
                   2262:
1.37      noro     2263: void dp_make_flaglist(LIST *list)
1.1       noro     2264: {
1.43      noro     2265:        Q v,nm,dn;
1.1       noro     2266:        STRING name,path;
                   2267:        NODE n,n1;
                   2268:
1.43      noro     2269: #if 0
1.14      noro     2270:        STOQ(DP_Multiple,v); MKNODE(n,v,0); MKSTR(name,"DP_Multiple"); MKNODE(n1,name,n); n = n1;
1.1       noro     2271:        STOQ(Denominator,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Denominator"); MKNODE(n1,name,n); n = n1;
1.43      noro     2272: #else
                   2273:        if ( DP_Multiple ) {
                   2274:                STOQ(DP_Multiple,nm); STOQ(Denominator,dn); divq(nm,dn,&v);
                   2275:        } else
                   2276:                v = 0;
                   2277:        MKNODE(n,v,0); MKSTR(name,"Content"); MKNODE(n1,name,n); n = n1;
                   2278: #endif
1.1       noro     2279:        MKNODE(n1,Dist,n); n = n1; MKSTR(name,"Dist"); MKNODE(n1,name,n); n = n1;
                   2280:        STOQ(Reverse,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Reverse"); MKNODE(n1,name,n); n = n1;
                   2281:        STOQ(Stat,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Stat"); MKNODE(n1,name,n); n = n1;
1.14      noro     2282:        STOQ(DP_Print,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Print"); MKNODE(n1,name,n); n = n1;
1.20      noro     2283:        STOQ(DP_PrintShort,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"PrintShort"); MKNODE(n1,name,n); n = n1;
1.14      noro     2284:        STOQ(DP_NFStat,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NFStat"); MKNODE(n1,name,n); n = n1;
1.7       noro     2285:        STOQ(OXCheck,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"OXCheck"); MKNODE(n1,name,n); n = n1;
                   2286:        STOQ(GenTrace,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"GenTrace"); MKNODE(n1,name,n); n = n1;
1.1       noro     2287:        STOQ(PtozpRA,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"PtozpRA"); MKNODE(n1,name,n); n = n1;
                   2288:        STOQ(ShowMag,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"ShowMag"); MKNODE(n1,name,n); n = n1;
                   2289:        STOQ(Top,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Top"); MKNODE(n1,name,n); n = n1;
                   2290:        STOQ(NoGCD,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoGCD"); MKNODE(n1,name,n); n = n1;
                   2291:        STOQ(NoRA,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoRA"); MKNODE(n1,name,n); n = n1;
                   2292:        STOQ(NoMC,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoMC"); MKNODE(n1,name,n); n = n1;
                   2293:        STOQ(NoGC,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoGC"); MKNODE(n1,name,n); n = n1;
                   2294:        STOQ(NoCriB,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoCriB"); MKNODE(n1,name,n); n = n1;
                   2295:        STOQ(NoSugar,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoSugar"); MKNODE(n1,name,n); n = n1;
                   2296:        if ( Demand )
                   2297:                MKSTR(path,Demand);
                   2298:        else
                   2299:                path = 0;
                   2300:        MKNODE(n1,path,n); n = n1; MKSTR(name,"Demand"); MKNODE(n1,name,n); n = n1;
                   2301:        MKLIST(*list,n);
                   2302: }
                   2303:
                   2304: #define DELIM '/'
                   2305:
1.37      noro     2306: void dp_save(int index,Obj p,char *prefix)
1.1       noro     2307: {
                   2308:        FILE *fp;
                   2309:        char path[BUFSIZ];
                   2310:
1.7       noro     2311:        if ( prefix )
                   2312:                sprintf(path,"%s%c%s%d",Demand,DELIM,prefix,index);
                   2313:        else
                   2314:                sprintf(path,"%s%c%d",Demand,DELIM,index);
1.1       noro     2315:        if ( !(fp = fopen(path,"wb") ) )
                   2316:                error("dp_save : cannot open a file");
1.7       noro     2317:        savevl(fp,VC); saveobj(fp,p); fclose(fp);
1.1       noro     2318: }
                   2319:
1.37      noro     2320: void dp_load(int index,DP *p)
1.1       noro     2321: {
                   2322:        FILE *fp;
                   2323:        char path[BUFSIZ];
                   2324:
                   2325:        if ( !Demand || ps[index] )
                   2326:                *p = ps[index];
                   2327:        else {
                   2328:                sprintf(path,"%s%c%d",Demand,DELIM,index);
                   2329:                if ( !(fp = fopen(path,"rb") ) )
                   2330:                        error("dp_load : cannot open a file");
1.45      noro     2331:                if ( PCoeffs )
                   2332:                        loadvl(fp);
                   2333:                else
                   2334:                        skipvl(fp);
                   2335:                loadobj(fp,(Obj *)p); fclose(fp);
1.1       noro     2336:        }
                   2337: }
                   2338:
1.37      noro     2339: int dp_load_t(int index,DP *p)
1.1       noro     2340: {
                   2341:        FILE *fp;
                   2342:        char path[BUFSIZ];
                   2343:
                   2344:        sprintf(path,"%s%c%d",Demand,DELIM,index);
                   2345:        if ( !(fp = fopen(path,"rb") ) )
                   2346:                return 0;
                   2347:        else {
1.45      noro     2348:                if ( PCoeffs )
                   2349:                        loadvl(fp);
                   2350:                else
                   2351:                        skipvl(fp);
                   2352:                loadobj(fp,(Obj *)p); fclose(fp); return 1;
1.1       noro     2353:        }
                   2354: }
                   2355:
                   2356: void init_stat() {
                   2357:        init_eg(&eg_nf); init_eg(&eg_nfm); init_eg(&eg_znfm);
1.14      noro     2358:        init_eg(&eg_pz); init_eg(&eg_np);
1.1       noro     2359:        init_eg(&eg_ra); init_eg(&eg_mc); init_eg(&eg_gc);
1.35      noro     2360:        ZR = NZR = TP = NMP = NBP = NFP = NDP = 0;
1.1       noro     2361: }
                   2362:
                   2363: void print_stat() {
1.12      noro     2364:        if ( !DP_Print && !Stat )
1.1       noro     2365:                return;
                   2366:        print_eg("NF",&eg_nf); print_eg("NFM",&eg_nfm); print_eg("ZNFM",&eg_znfm);
1.14      noro     2367:        print_eg("PZ",&eg_pz); print_eg("NP",&eg_np);
1.1       noro     2368:        print_eg("RA",&eg_ra); print_eg("MC",&eg_mc); print_eg("GC",&eg_gc);
                   2369:        fprintf(asir_out,"T=%d,B=%d M=%d F=%d D=%d ZR=%d NZR=%d\n",TP,NBP,NMP,NFP,NDP,ZR,NZR);
                   2370: }
1.14      noro     2371:
                   2372: /*
                   2373:  * dp_nf used in gb()
                   2374:  *
                   2375:  */
                   2376:
                   2377: double pz_t_e, pz_t_d, pz_t_d1, pz_t_c, im_t_s, im_t_r;
                   2378:
                   2379: extern int GenTrace;
                   2380: extern NODE TraceList;
1.15      noro     2381: extern int mpi_mag;
                   2382:
1.37      noro     2383: void dp_mulc_d(DP p,P c,DP *r)
1.15      noro     2384: {
                   2385:        if ( Dist && BDY(Dist)
                   2386:                && HMAG(p) > mpi_mag
                   2387:                && p_mag((P)c) > mpi_mag ) {
                   2388:                if ( DP_NFStat ) fprintf(asir_out,"~");
                   2389:                dp_imul_d(p,(Q)c,r);
                   2390:        } else {
                   2391:                if ( DP_NFStat ) fprintf(asir_out,"_");
                   2392:                muldc(CO,p,c,r);
                   2393:        }
                   2394: }
1.14      noro     2395:
1.37      noro     2396: void _dp_nf(NODE b,DP g,DP *ps,int full,DP *rp)
1.16      noro     2397: {
                   2398:        DP u,p,d,s,t,mult;
                   2399:        P coef;
                   2400:        NODE l;
                   2401:        MP m,mr;
                   2402:        int sugar,psugar;
                   2403:
                   2404:        if ( !g ) {
                   2405:                *rp = 0; return;
                   2406:        }
                   2407:        sugar = g->sugar;
                   2408:        for ( d = 0; g; ) {
                   2409:                for ( u = 0, l = b; l; l = NEXT(l) ) {
                   2410:                        if ( dl_redble(BDY(g)->dl,psh[(int)BDY(l)]) ) {
                   2411:                                dp_load((int)BDY(l),&p);
                   2412:                                /* t+u = coef*(d+g) - mult*p (t = coef*d) */
                   2413:                                dp_red(d,g,p,&t,&u,&coef,&mult);
                   2414:                                psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar;
                   2415:                                sugar = MAX(sugar,psugar);
                   2416:                                if ( GenTrace ) {
                   2417:                                        LIST hist;
                   2418:                                        Q cq;
                   2419:                                        NODE node,node0;
                   2420:
                   2421:                                        STOQ((int)BDY(l),cq);
                   2422:                                        node0 = mknode(4,coef,cq,mult,ONE);
                   2423:                                        MKLIST(hist,node0);
                   2424:                                        MKNODE(node,hist,TraceList); TraceList = node;
                   2425:                                }
                   2426:                                if ( !u ) {
                   2427:                                        if ( d )
                   2428:                                                d->sugar = sugar;
                   2429:                                        *rp = d; return;
                   2430:                                }
                   2431:                                d = t;
                   2432:                                break;
                   2433:                        }
                   2434:                }
                   2435:                if ( u )
                   2436:                        g = u;
                   2437:                else if ( !full ) {
                   2438:                        if ( g ) {
                   2439:                                MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t;
                   2440:                        }
                   2441:                        *rp = g; return;
                   2442:                } else {
                   2443:                        m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c;
                   2444:                        NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td;
                   2445:                        addd(CO,d,t,&s); d = s;
                   2446:                        dp_rest(g,&t); g = t;
                   2447:                }
                   2448:        }
                   2449:        if ( d )
                   2450:                d->sugar = sugar;
                   2451:        *rp = d;
                   2452: }
                   2453:
1.37      noro     2454: void _dp_nf_z(NODE b,DP g,DP *ps,int full,int multiple,DP *r)
1.14      noro     2455: {
1.37      noro     2456:        DP u,dp,rp,t,t1,red,shift;
1.14      noro     2457:        Q dc,rc,dcq,rcq,cont,hr,hred,cr,cred,mcred,c,gcd,cq;
                   2458:        NODE l;
                   2459:        int hmag,denom;
                   2460:        int sugar,psugar;
                   2461:        STRING imul;
1.37      noro     2462:        double t_0,tt,t_p,t_m,t_g,t_a;
1.14      noro     2463:        LIST hist;
                   2464:        NODE node;
                   2465:        Q rcred,mrcred;
                   2466:
                   2467:        if ( !g ) {
                   2468:                *r = 0; return;
                   2469:        }
                   2470:        pz_t_e = pz_t_d = pz_t_d1 = pz_t_c = 0;
1.15      noro     2471:        t_p = t_m = t_g = t_a = 0;
1.14      noro     2472:
                   2473:        denom = Denominator?Denominator:1;
                   2474:        hmag = multiple*HMAG(g)/denom;
                   2475:        sugar = g->sugar;
                   2476:
                   2477:        dc = 0; dp = 0; rc = ONE; rp = g;
                   2478:        MKSTR(imul,"dp_imul_index");
                   2479:
                   2480:        /* g = dc*dp+rc*rp */
                   2481:        for ( ; rp; ) {
                   2482:                for ( u = 0, l = b; l; l = NEXT(l) ) {
                   2483:                        if ( dl_redble(BDY(rp)->dl,psh[(int)BDY(l)]) ) {
                   2484:                                t_0 = get_rtime();
                   2485:                                dp_load((int)BDY(l),&red);
                   2486:                                hr = (Q)BDY(rp)->c; hred = (Q)BDY(red)->c;
                   2487:                                igcd_cofactor((Q)BDY(rp)->c,(Q)BDY(red)->c,&gcd,&cred,&cr);
1.15      noro     2488:                                tt = get_rtime(); t_p += tt-t_0;
1.14      noro     2489:
                   2490:                                dp_subd(rp,red,&shift);
1.37      noro     2491:                                dp_mulc_d(rp,(P)cr,&t);
1.14      noro     2492:                                chsgnp((P)cred,(P *)&mcred);
1.37      noro     2493:                                dp_mulc_d(red,(P)mcred,&t1);
1.15      noro     2494:                                muld(CO,shift,t1,&t1);
                   2495:                                addd(CO,t,t1,&u);
                   2496:                                t_m += get_rtime()-tt;
1.14      noro     2497:
                   2498:                                psugar = (BDY(rp)->dl->td - BDY(red)->dl->td) + red->sugar;
                   2499:                                sugar = MAX(sugar,psugar);
1.15      noro     2500:
1.14      noro     2501:                                if ( GenTrace ) {
                   2502:                                        /* u = cr*rp + (-cred)*shift*red */
                   2503:                                        STOQ((int)BDY(l),cq);
                   2504:                                        node = mknode(4,cr,cq,0,0);
                   2505:                                        mulq(cred,rc,&rcred);
                   2506:                                        chsgnnum((Num)rcred,(Num *)&mrcred);
                   2507:                                        muldc(CO,shift,(P)mrcred,(DP *)&ARG2(node));
                   2508:                                        MKLIST(hist,node);
                   2509:                                }
1.15      noro     2510:
1.14      noro     2511:                                if ( !u ) {
                   2512:                                        if ( dp )
                   2513:                                                dp->sugar = sugar;
                   2514:                                        *r = dp;
                   2515:                                        if ( GenTrace ) {
                   2516:                                                ARG3(BDY(hist)) = ONE;
                   2517:                                                MKNODE(node,hist,TraceList); TraceList = node;
                   2518:                                        }
                   2519:                                        goto final;
                   2520:                                }
                   2521:                                break;
                   2522:                        }
                   2523:                }
                   2524:                if ( u ) {
                   2525:                        if ( multiple && HMAG(u) > hmag ) {
                   2526:                                t_0 = get_rtime();
1.16      noro     2527:                                dp_ptozp_d(u,&rp);
1.15      noro     2528:                                tt = get_rtime(); t_g += tt-t_0;
                   2529:
                   2530:                                divsq((Q)BDY(u)->c,(Q)BDY(rp)->c,&cont);
1.14      noro     2531:                                if ( !dp_fcoeffs && DP_NFStat ) {
1.15      noro     2532:                                        fprintf(asir_out,
                   2533:                                                "(%d)",p_mag((P)cont)*100/p_mag((P)BDY(u)->c));
1.14      noro     2534:                                        fflush(asir_out);
                   2535:                                }
1.15      noro     2536:                                mulq(cr,dc,&dcq); mulq(cont,rc,&rcq);
1.14      noro     2537:                                igcd_cofactor(dcq,rcq,&gcd,&dc,&rc);
1.15      noro     2538:                                t_a = get_rtime()-tt;
                   2539:
1.14      noro     2540:                                hmag = multiple*HMAG(rp)/denom;
                   2541:                                if ( GenTrace ) {
                   2542:                                        ARG3(BDY(hist)) = (pointer)gcd;
                   2543:                                        MKNODE(node,hist,TraceList); TraceList = node;
                   2544:                                }
                   2545:                        } else {
1.15      noro     2546:                                rp = u;
1.14      noro     2547:                                t_0 = get_rtime();
1.15      noro     2548:                                mulq(cr,dc,&dc);
                   2549:                                t_a += get_rtime()-t_0;
1.14      noro     2550:                                if ( GenTrace ) {
                   2551:                                        ARG3(BDY(hist)) = (pointer)ONE;
                   2552:                                        MKNODE(node,hist,TraceList); TraceList = node;
                   2553:                                }
                   2554:                        }
                   2555:                } else if ( !full ) {
                   2556:                        if ( rp ) {
                   2557:                                MKDP(rp->nv,BDY(rp),t); t->sugar = sugar; rp = t;
                   2558:                        }
                   2559:                        *r = rp;
                   2560:                        goto final;
                   2561:                } else {
                   2562:                        t_0 = get_rtime();
                   2563:                        mulq((Q)BDY(rp)->c,rc,&c);
1.15      noro     2564:                        igcd_cofactor(dc,c,&dc,&dcq,&cq);
                   2565:                        muldc(CO,dp,(P)dcq,&t);
                   2566:                        dp_hm(rp,&t1); BDY(t1)->c = (P)cq;  addd(CO,t,t1,&dp);
                   2567:                        dp_rest(rp,&rp);
                   2568:                        t_a += get_rtime()-t_0;
1.14      noro     2569:                }
                   2570:        }
                   2571:        if ( GenTrace ) {
                   2572:                mulq(ARG3(BDY((LIST)BDY(TraceList))),dc,&cq);
                   2573:                ARG3(BDY((LIST)BDY(TraceList))) = (pointer)cq;
                   2574:        }
                   2575:        if ( dp )
                   2576:                dp->sugar = sugar;
                   2577:        *r = dp;
                   2578: final:
                   2579:        if ( DP_NFStat )
1.15      noro     2580:                fprintf(asir_out,
                   2581:                        "(%.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g)",
                   2582:                        t_p,t_m,t_g,t_a,
1.14      noro     2583:                        pz_t_e, pz_t_d, pz_t_d1, pz_t_c);
                   2584: }
                   2585:
                   2586: void imulv();
                   2587:
1.37      noro     2588: void dp_imul_d(DP p,Q q,DP *rp)
1.14      noro     2589: {
                   2590:        int nsep,ndist,i,j,k,l,n;
                   2591:        double t0,t1,t2;
                   2592:        Q *s;
                   2593:        pointer *b;
                   2594:        VECT c,cs,ri;
                   2595:        VECT *r;
                   2596:        MP m;
1.37      noro     2597:        NODE tn,dist,n0;
                   2598:        Obj obj;
1.14      noro     2599:        STRING imul;
                   2600:        extern LIST Dist;
                   2601:
                   2602:        if ( !p || !q ) {
                   2603:                *rp = 0; return;
                   2604:        }
                   2605:        dist = BDY(Dist);
                   2606:        for ( tn = dist, ndist = 0; tn; tn = NEXT(tn), ndist++ );
                   2607:        nsep = ndist + 1;
                   2608:        for ( m = BDY(p), n = 0; m; m = NEXT(m), n++ );
                   2609:        if ( n <= nsep ) {
                   2610:                muldc(CO,p,(P)q,rp); return;
                   2611:        }
                   2612:        MKSTR(imul,"imulv");
                   2613:        t0 = get_rtime();
                   2614:        dp_dtov(p,&c);
                   2615:        sepvect(c,nsep,&cs);
                   2616:        r = (VECT *)CALLOC(nsep,sizeof(VECT *));
                   2617:        for ( i = 0, tn = dist, b = BDY(cs); i < ndist; i++, tn = NEXT(tn) ) {
                   2618:                n0 = mknode(4,BDY(tn),imul,b[i],q);
1.37      noro     2619:                Pox_rpc(n0,&obj);
1.14      noro     2620:        }
                   2621:        t1 = get_rtime();
                   2622:        im_t_s += t1 - t0;
                   2623:        imulv(b[i],q,&r[i]);
                   2624:        t1 = get_rtime();
                   2625:        for ( i = 0, tn = dist; i < ndist; i++, tn = NEXT(tn) ) {
                   2626:                MKNODE(n0,BDY(tn),0);
1.37      noro     2627:                Pox_pop_local(n0,&obj); r[i] = (VECT)obj;
1.14      noro     2628:                if ( OID(r[i]) == O_ERR ) {
                   2629:                        printexpr(CO,(Obj)r[i]);
                   2630:                        error("dp_imul_d : aborted");
                   2631:                }
                   2632:        }
                   2633:        t2 = get_rtime();
                   2634:        im_t_r += t2 - t1;
                   2635:        s = (Q *)CALLOC(n,sizeof(Q));
                   2636:        for ( i = j = 0; i < nsep; i++ ) {
                   2637:                for ( k = 0, ri = r[i], l = ri->len; k < l; k++, j++ ) {
                   2638:                        s[j] = (Q)BDY(ri)[k];
                   2639:                }
                   2640:        }
                   2641:        dp_vtod(s,p,rp);
                   2642: }
                   2643:
1.37      noro     2644: void imulv(VECT w,Q c,VECT *rp)
1.14      noro     2645: {
                   2646:        int n,i;
                   2647:        VECT r;
                   2648:
                   2649:        n = w->len;
                   2650:        MKVECT(r,n); *rp = r;
                   2651:        for ( i = 0; i < n; i++ )
                   2652:                mulq((Q)BDY(w)[i],(Q)c,(Q *)&BDY(r)[i]);
1.32      noro     2653: }
                   2654:
1.37      noro     2655: void dptoca(DP p,unsigned int **rp)
1.32      noro     2656: {
                   2657:        int i;
                   2658:        MP m;
                   2659:        unsigned int *r;
                   2660:
                   2661:        if ( !p )
                   2662:                *rp = 0;
                   2663:        else {
                   2664:                for ( m = BDY(p), i = 0; m; m = NEXT(m), i++ );
                   2665:                *rp = r = (unsigned int *)MALLOC_ATOMIC(i*sizeof(unsigned int));
                   2666:                for ( m = BDY(p), i = 0; m; m = NEXT(m), i++ )
                   2667:                        r[i] = ITOS(C(m));
                   2668:        }
1.14      noro     2669: }
                   2670:

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