OpenXM_contrib2/asir2000/builtin/gr.c - diff

Return to gr.c CVS log

Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Diff for /OpenXM_contrib2/asir2000/builtin/gr.c between version 1.9 and 1.74

-version 1.9, 2000/08/22 05:03:58
+version 1.74, 2018/03/29 01:32:50
 Line 45
 Line 45
 Line 45
   * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
   * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
   *
-  * $OpenXM: OpenXM_contrib2/asir2000/builtin/gr.c,v 1.8 2000/08/21 08:31:19 noro Exp $
+  * $OpenXM: OpenXM_contrib2/asir2000/builtin/gr.c,v 1.73 2017/08/31 02:36:20 noro Exp $
  */
  #include "ca.h"
  #include "parse.h"
  #include "base.h"
  #include "ox.h"
- #define ITOS(p) (((unsigned int)(p))&0x7fffffff)
+ #if defined(__GNUC__)
- #define STOI(i) ((P)((unsigned int)(i)|0x80000000))
+ #define INLINE static inline
+ #elif defined(VISUAL) || defined(__MINGW32__)
+ #define INLINE __inline
+ #else
+ #define INLINE
+ #endif
- #define NEXTVL(r,c) \
+ #define HMAG(p) (p_mag((P)BDY(p)->c))
- if(!(r)){NEWVL(r);(c)=(r);}else{NEWVL(NEXT(c));(c)=NEXT(c);}
- #define HMAG(p) (p_mag(BDY(p)->c))
+ #define NEWDP_pairs ((DP_pairs)MALLOC(sizeof(struct dp_pairs)))
- struct dp_pairs {
+ static DP_pairs collect_pairs_of_hdlcm( DP_pairs d1, DP_pairs *prest );
-         int dp1, dp2;
+ double get_rtime();
-         DL lcm;
-         int sugar;
-         struct dp_pairs *next;
- };
- typedef struct dp_pairs *DP_pairs;
+ struct oEGT eg_nf,eg_nfm;
+ struct oEGT eg_znfm,eg_pz,eg_np,eg_ra,eg_mc,eg_gc;
+ int TP,N_BP,NMP,NFP,NDP,ZR,NZR;
- #define NEWDPP(a) ((a)=(DP_pairs)MALLOC(sizeof(struct dp_pairs)))
- #define NEXTDPP(r,c) \
- if(!(r)){NEWDPP(r);(c)=(r);}else{NEWDPP(NEXT(c));(c)=NEXT(c);}
- struct oEGT eg_up,eg_sp,eg_spm,eg_nf,eg_nfm;
- struct oEGT eg_znfm,eg_pz,eg_np,eg_mp,eg_ra,eg_mc,eg_gc;
- int TP,NBP,NMP,NFP,NDP,ZR,NZR;
- #define NEWDP_pairs ((DP_pairs)MALLOC(sizeof(struct dp_pairs)))
  extern int (*cmpdl)();
  extern int do_weyl;
- void Pdp_gr_flags(), Pdp_gr_print();
+ extern DP_Print;
- void Pdp_gr_main(),Pdp_gr_mod_main(),Pdp_f4_main(),Pdp_f4_mod_main();
- void print_stat(void);
- void init_stat(void);
- int dp_load_t(int,DP *);
- void dp_load(int,DP *);
- void dp_save(int,Obj,char *);
- void dp_make_flaglist(LIST *);
- void dp_set_flag(Obj,Obj);
- int membercheck(NODE,NODE);
- int gbcheck(NODE);
- int dl_redble(DL,DL);
- NODE remove_reducibles(NODE,int);
- NODE updbase(NODE,int);
- DP_pairs criterion_F(DP_pairs);
- int criterion_2(int,int);
- static DP_pairs collect_pairs_of_hdlcm(DP_pairs,DP_pairs *);
- DP_pairs criterion_M(DP_pairs);
- DP_pairs criterion_B(DP_pairs,int);
- DP_pairs newpairs(NODE,int);
- DP_pairs updpairs(DP_pairs,NODE,int);
- void _dp_nf_ptozp(NODE,DP,DP *,int,int,DP *);
- void _dp_nf_ptozp_mpi(NODE,DP,DP *,int,int,DP *);
- void _dp_nf(NODE,DP,DP *,int,DP *);
- void _dp_nf_mod(NODE,DP,DP *,int,int,DP *);
- void interreduce_mod(NODE,int,int);
- NODE gb_mod(NODE,int);
- NODE gbd(NODE,int,NODE,NODE);
- NODE gb(NODE,int,NODE);
- NODE gb_f4(NODE);
- NODE gb_f4_mod(NODE,int);
- DP_pairs minp(DP_pairs, DP_pairs *);
- void minsugar(DP_pairs,DP_pairs *,DP_pairs *);
- NODE append_one(NODE,int);
- void reducebase_dehomo(NODE,NODE *);
- int newps_mod(DP,int);
- int newps_nosave(DP,int,NODE);
- int newps(DP,int,NODE);
- void reduceall_mod(NODE,int,NODE *);
- void reduceall(NODE,NODE *);
- NODE NODE_sortbi(NODE,int);
- NODE NODE_sortbi_insert(int, NODE,int);
- NODE NODE_sortb(NODE,int);
- NODE NODE_sortb_insert(DP,NODE,int);
- void prim_part(DP,int,DP *);
- void setup_arrays(NODE,int,NODE *);
- int validhc(P,int,NODE);
- void vlminus(VL,VL,VL *);
- void printsubst(NODE);
- void makesubst(VL,NODE *);
- void pltovl(LIST,VL *);
- void printdl(DL);
- int DPPlength(DP_pairs);
- void dp_gr_mod_main(LIST,LIST,Num,int,struct order_spec *,LIST *);
- void dp_gr_main(LIST,LIST,Num,int,struct order_spec *,LIST *);
- void dp_f4_main(LIST,LIST,struct order_spec *,LIST *);
- void dp_f4_mod_main(LIST,LIST,int,struct order_spec *,LIST *);
- double get_rtime();
- void _dpmod_to_vect(DP,DL *,int *);
- void dp_to_vect(DP,DL *,Q *);
- NODE dp_dllist(DP f),symb_merge(NODE,NODE,int);
  extern int dp_nelim;
  extern int dp_fcoeffs;
  static DP *ps,*psm;
-Line 154  static P *psc;
+Line 84  static P *psc;
 Line 154  static P *psc;
 Line 84  static P *psc;
  static int *pss;
  static int psn,pslen;
- static int NVars,CNVars,PCoeffs;
+ static int NVars,CNVars;
  static VL VC;
- static int NoSugar = 0;
+ int PCoeffs;
+ int DP_Print = 0;
+ int DP_PrintShort = 0;
+ int DP_Multiple = 0;
+ int DP_NFStat = 0;
+ LIST Dist = 0;
+ int NoGCD = 0;
+ int GenTrace = 0;
+ int GenSyz = 0;
+ int OXCheck = -1;
+ int OneZeroHomo = 0;
+ int MaxDeg = 0;
+ int NoSugar = 0;
  static int NoCriB = 0;
  static int NoGC = 0;
  static int NoMC = 0;
  static int NoRA = 0;
- int Print = 0;
- static int PrintShort = 0;
  static int ShowMag = 0;
  static int Stat = 0;
- static int Multiple = 0;
+ int Denominator = 1;
- static int Denominator = 1;
+ int Top = 0;
- static int Top = 0;
+ int Reverse = 0;
- static int Reverse = 0;
- static int InterReduce = 0;
  static int Max_mag = 0;
- static char *Demand = 0;
+ static int Max_coef = 0;
+ char *Demand = 0;
  static int PtozpRA = 0;
- LIST Dist = 0;
- int NoGCD = 0;
- int GenTrace = 0;
- int OXCheck = -1;
  int doing_f4;
  NODE TraceList;
+ NODE AllTraceList;
- void Pdp_gr_flags(arg,rp)
+ void Pox_cmo_rpc(NODE,Obj *);
- NODE arg;
+ void Pox_rpc(NODE,Obj *);
- LIST *rp;
+ void Pox_pop_local(NODE,Obj *);
+ INLINE int eqdl(int nv,DL dl1,DL dl2)
  {
-         Obj name,value;
+   int i;
-         NODE n;
+   int *p1,*p2;
-         if ( arg ) {
+   if ( dl1->td != dl2->td )
-                 asir_assert(ARG0(arg),O_LIST,"dp_gr_flags");
+     return 0;
-                 n = BDY((LIST)ARG0(arg));
+   i = nv-1;
-                 while ( n ) {
+   p1 = dl1->d;
-                         name = (Obj)BDY(n); n = NEXT(n);
+   p2 = dl2->d;
-                         if ( !n )
+   while ( i >= 7 ) {
-                                 break;
+     if ( *p1++ != *p2++ ) return 0;
-                         else {
+     if ( *p1++ != *p2++ ) return 0;
-                                 value = (Obj)BDY(n); n = NEXT(n);
+     if ( *p1++ != *p2++ ) return 0;
-                         }
+     if ( *p1++ != *p2++ ) return 0;
-                         dp_set_flag(name,value);
+     if ( *p1++ != *p2++ ) return 0;
-                 }
+     if ( *p1++ != *p2++ ) return 0;
-         }
+     if ( *p1++ != *p2++ ) return 0;
-         dp_make_flaglist(rp);
+     if ( *p1++ != *p2++ ) return 0;
+     i -= 8;
+   }
+   switch ( i ) {
+     case 6:
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       return 1;
+     case 5:
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       return 1;
+     case 4:
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       return 1;
+     case 3:
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       return 1;
+     case 2:
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       return 1;
+     case 1:
+       if ( *p1++ != *p2++ ) return 0;
+       if ( *p1++ != *p2++ ) return 0;
+       return 1;
+     case 0:
+       if ( *p1++ != *p2++ ) return 0;
+       return 1;
+     default:
+       return 1;
+   }
  }
- void Pdp_gr_print(arg,rp)
+ /* b[] should be cleared */
- NODE arg;
- Q *rp;
+ void _dpmod_to_vect(DP f,DL *at,int *b)
  {
-         Q q;
+   int i,nv;
+   MP m;
-         if ( arg ) {
+   nv = f->nv;
-                 asir_assert(ARG0(arg),O_N,"dp_gr_print");
+   for ( m = BDY(f), i = 0; m; m = NEXT(m), i++ ) {
-                 q = (Q)ARG0(arg); Print = QTOS(q);
+     for ( ; !eqdl(nv,m->dl,at[i]); i++ );
-         } else
+     b[i] = ITOS(m->c);
-                 STOQ(Print,q);
+   }
-         *rp = q;
  }
- void Pdp_gr_main(arg,rp)
+ /* [t,findex] -> tf -> compressed vector */
- NODE arg;
- LIST *rp;
+ void _tf_to_vect_compress(NODE tf,DL *at,CDP *b)
  {
-         LIST f,v;
+   int i,j,k,nv,len;
-         Num homo;
+   DL t,s,d1;
-         Q m;
+   DP f;
-         int modular;
+   MP m;
-         struct order_spec ord;
+   CDP r;
-         asir_assert(ARG0(arg),O_LIST,"dp_gr_main");
+   t = (DL)BDY(tf);
-         asir_assert(ARG1(arg),O_LIST,"dp_gr_main");
+   f = ps[(int)BDY(NEXT(tf))];
-         asir_assert(ARG2(arg),O_N,"dp_gr_main");
-         asir_assert(ARG3(arg),O_N,"dp_gr_main");
-         f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
-         homo = (Num)ARG2(arg);
-         m = (Q)ARG3(arg);
-         if ( !m )
-                 modular = 0;
-         else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) )
-                 error("dp_gr_main : too large modulus");
-         else
-                 modular = QTOS(m);
-         create_order_spec(ARG4(arg),&ord);
-         dp_gr_main(f,v,homo,modular,&ord,rp);
- }
- void Pdp_f4_main(arg,rp)
+   nv = f->nv;
- NODE arg;
+   for ( m = BDY(f), len = 0; m; m = NEXT(m), len++ );
- LIST *rp;
+   r = (CDP)MALLOC(sizeof(struct oCDP));
- {
+    r->len = len;
-         LIST f,v;
+   r->psindex = (int)BDY(NEXT(tf));
-         struct order_spec ord;
+   r->body = (unsigned int *)MALLOC_ATOMIC(sizeof(unsigned int)*len);
-         asir_assert(ARG0(arg),O_LIST,"dp_f4_main");
+   NEWDL_NOINIT(s,nv);
-         asir_assert(ARG1(arg),O_LIST,"dp_f4_main");
+   for ( m = BDY(f), i = j = 0; m; m = NEXT(m), j++ ) {
-         f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
+     d1 = m->dl;
-         create_order_spec(ARG2(arg),&ord);
+     s->td = t->td+d1->td;
-         dp_f4_main(f,v,&ord,rp);
+     for ( k = 0; k < nv; k++ )
+       s->d[k] = t->d[k]+d1->d[k];
+     for ( ; !eqdl(nv,s,at[i]); i++ );
+     r->body[j] = i;
+   }
+   *b = r;
  }
- void Pdp_f4_mod_main(arg,rp)
+ void dp_to_vect(DP f,DL *at,Q *b)
- NODE arg;
- LIST *rp;
  {
-         LIST f,v;
+   int i,nv;
-         int m;
+   MP m;
-         struct order_spec ord;
-         asir_assert(ARG0(arg),O_LIST,"dp_f4_main");
+   nv = f->nv;
-         asir_assert(ARG1(arg),O_LIST,"dp_f4_main");
+   for ( m = BDY(f), i = 0; m; m = NEXT(m), i++ ) {
-         asir_assert(ARG2(arg),O_N,"dp_f4_main");
+     for ( ; !eqdl(nv,m->dl,at[i]); i++ );
-         f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg));
+     b[i] =(Q)m->c;
-         create_order_spec(ARG3(arg),&ord);
+   }
-         dp_f4_mod_main(f,v,m,&ord,rp);
  }
- void Pdp_gr_mod_main(arg,rp)
+ NODE dp_dllist(DP f)
- NODE arg;
- LIST *rp;
  {
-         LIST f,v;
+   MP m;
-         Num homo;
+   NODE mp,mp0;
-         int m;
-         struct order_spec ord;
-         asir_assert(ARG0(arg),O_LIST,"dp_gr_mod_main");
+   if ( !f )
-         asir_assert(ARG1(arg),O_LIST,"dp_gr_mod_main");
+     return 0;
-         asir_assert(ARG2(arg),O_N,"dp_gr_mod_main");
+   mp0 = 0;
-         asir_assert(ARG3(arg),O_N,"dp_gr_mod_main");
+   for ( m = BDY(f); m; m = NEXT(m) ) {
-         f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
+     NEXTNODE(mp0,mp); BDY(mp) = (pointer)m->dl;
-         homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg));
+   }
-         create_order_spec(ARG4(arg),&ord);
+   NEXT(mp) = 0;
-         dp_gr_mod_main(f,v,homo,m,&ord,rp);
+   return mp0;
  }
- int eqdl(nv,dl1,dl2)
+ NODE mul_dllist(DL d,DP f)
- int nv;
- DL dl1,dl2;
  {
-         int i;
+   MP m;
-         int *b1,*b2;
+   NODE mp,mp0;
+   DL t,d1;
+   int i,nv;
-         if ( dl1->td != dl2->td )
+   if ( !f )
-                 return 0;
+     return 0;
-         for ( i = 0, b1 = dl1->d, b2 = dl2->d; i < nv; i++ )
+   nv = NV(f);
-                 if ( b1[i] != b2[i] )
+   mp0 = 0;
-                         break;
+   for ( m = BDY(f); m; m = NEXT(m) ) {
-         if ( i == nv )
+     NEXTNODE(mp0,mp);
-                 return 1;
+     NEWDL_NOINIT(t,nv);
-         else
+     d1 = m->dl;
-                 return 0;
+     t->td = d->td+d1->td;
+     for ( i = 0; i < nv; i++ )
+       t->d[i] = d->d[i]+d1->d[i];
+     BDY(mp) = (pointer)t;
+   }
+   NEXT(mp) = 0;
+   return mp0;
  }
- /* b[] should be cleared */
+ void pdl(NODE f)
- void _dpmod_to_vect(f,at,b)
- DP f;
- DL *at;
- int *b;
  {
-         int i,nv;
+   while ( f ) {
-         MP m;
+     printdl(BDY(f)); f = NEXT(f);
+   }
-         nv = f->nv;
+   fflush(stdout);
-         for ( m = BDY(f), i = 0; m; m = NEXT(m), i++ ) {
+   printf("\n");
-                 for ( ; !eqdl(nv,m->dl,at[i]); i++ );
-                 b[i] = ITOS(m->c);
-         }
  }
- void dp_to_vect(f,at,b)
+ void dp_gr_main(LIST f,LIST v,Num homo,int modular,int field,struct order_spec *ord,LIST *rp)
- DP f;
- DL *at;
- Q *b;
  {
-         int i,nv;
+   int i,mindex,m,nochk;
-         MP m;
+   struct order_spec *ord1;
+   Q q;
+   VL fv,vv,vc;
+   NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx;
+   NODE ind,ind0;
+   LIST trace,gbindex;
+   int input_is_dp = 0;
-         nv = f->nv;
+   mindex = 0; nochk = 0; dp_fcoeffs = field;
-         for ( m = BDY(f), i = 0; m; m = NEXT(m), i++ ) {
+   get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
-                 for ( ; !eqdl(nv,m->dl,at[i]); i++ );
+   NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
-                 b[i] =(Q)m->c;
+   CNVars = homo ? NVars+1 : NVars;
-         }
+   if ( ord->id && NVars != ord->nv )
- }
+     error("dp_gr_main : invalid order specification");
+   initd(ord);
+   if ( homo ) {
+     homogenize_order(ord,NVars,&ord1);
+     for ( fd0 = fi0 = 0, t = BDY(f); t; t = NEXT(t) ) {
+       NEXTNODE(fd0,fd); NEXTNODE(fi0,fi);
+       if ( BDY(t) && OID(BDY(t)) == O_DP ) {
+         dp_sort((DP)BDY(t),(DP *)&BDY(fi)); input_is_dp = 1;
+       } else
+         ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fi));
+       dp_homo((DP)BDY(fi),(DP *)&BDY(fd));
+     }
+     if ( fd0 ) NEXT(fd) = 0;
+     if ( fi0 ) NEXT(fi) = 0;
+     initd(ord1);
+   } else {
+     for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
+       NEXTNODE(fd0,fd);
+       if ( BDY(t) && OID(BDY(t)) == O_DP ) {
+         dp_sort((DP)BDY(t),(DP *)&BDY(fd)); input_is_dp = 1;
+       } else
+         ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fd));
+     }
+     if ( fd0 ) NEXT(fd) = 0;
+     fi0 = fd0;
+   }
+   if ( modular < 0 ) {
+     modular = -modular; nochk = 1;
+   }
+   if ( modular )
+     m = modular > 1 ? modular : get_lprime(mindex);
+   else
+     m = 0;
+   makesubst(vc,&subst);
+   setup_arrays(fd0,0,&s);
+   init_stat();
+   while ( 1 ) {
+     if ( homo ) {
+       initd(ord1); CNVars = NVars+1;
+     }
+     if ( DP_Print && modular ) {
+       fprintf(asir_out,"mod= %d, eval = ",m); printsubst(subst);
+     }
+     x = gb(s,m,subst);
+     if ( x ) {
+       if ( homo ) {
+         reducebase_dehomo(x,&xx); x = xx;
+         initd(ord); CNVars = NVars;
+       }
+       reduceall(x,&xx); x = xx;
+       if ( modular ) {
+         if ( nochk || (membercheck(fi0,x) && gbcheck(x)) )
+           break;
+       } else
+         break;
+     }
+     if ( modular )
+       if ( modular > 1 ) {
+         *rp = 0; return;
+       } else
+         m = get_lprime(++mindex);
+     makesubst(vc,&subst);
+     psn = length(s);
+     for ( i = psn; i < pslen; i++ ) {
+       pss[i] = 0; psh[i] = 0; psc[i] = 0; ps[i] = 0;
+     }
+   }
+   for ( r0 = 0, ind0 = 0; x; x = NEXT(x) ) {
+     NEXTNODE(r0,r); dp_load((int)BDY(x),&ps[(int)BDY(x)]);
+     if ( input_is_dp )
+       BDY(r) = (pointer)ps[(int)BDY(x)];
+     else
+       dtop(CO,vv,ps[(int)BDY(x)],(Obj *)&BDY(r));
+     NEXTNODE(ind0,ind);
+     STOQ((int)BDY(x),q); BDY(ind) = q;
+   }
+   if ( r0 ) NEXT(r) = 0;
+   if ( ind0 ) NEXT(ind) = 0;
+   MKLIST(*rp,r0);
+   MKLIST(gbindex,ind0);
- NODE dp_dllist(f)
+   if ( GenTrace && OXCheck < 0 ) {
- DP f;
- {
-         MP m;
-         NODE mp,mp0;
-         if ( !f )
+     x = AllTraceList;
-                 return 0;
+     for ( r = 0; x; x = NEXT(x) ) {
-         mp0 = 0;
+       MKNODE(r0,BDY(x),r); r = r0;
-         for ( m = BDY(f); m; m = NEXT(m) ) {
+     }
-                 NEXTNODE(mp0,mp); BDY(mp) = (pointer)m->dl;
+     MKLIST(trace,r);
-         }
+     r0 = mknode(3,*rp,gbindex,trace);
-         NEXT(mp) = 0;
+     MKLIST(*rp,r0);
-         return mp0;
+   }
+   print_stat();
+   if ( ShowMag )
+     fprintf(asir_out,"\nMax_mag=%d, Max_coef=%d\n",Max_mag, Max_coef);
  }
- void pdl(f)
+ void dp_interreduce(LIST f,LIST v,int field,struct order_spec *ord,LIST *rp)
- NODE f;
  {
-         while ( f ) {
+   int i,mindex,m,nochk;
-                 printdl(BDY(f)); f = NEXT(f);
+   struct order_spec *ord1;
-         }
+   Q q;
-         fflush(stdout);
+   VL fv,vv,vc;
-         printf("\n");
+   NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx;
- }
+   NODE ind,ind0;
+   LIST trace,gbindex;
+   int input_is_dp = 0;
- void dp_gr_main(f,v,homo,modular,ord,rp)
+   mindex = 0; nochk = 0; dp_fcoeffs = field;
- LIST f,v;
+   get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
- Num homo;
+   NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
- int modular;
+   CNVars = NVars;
- struct order_spec *ord;
+   if ( ord->id && NVars != ord->nv )
- LIST *rp;
+     error("dp_interreduce : invalid order specification");
- {
+   initd(ord);
-         int i,mindex,m,nochk;
+   for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
-         struct order_spec ord1;
+     NEXTNODE(fd0,fd);
-         VL fv,vv,vc;
+     if ( BDY(t) && OID(BDY(t)) == O_DP ) {
-         NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx;
+       dp_sort((DP)BDY(t),(DP *)&BDY(fd)); input_is_dp = 1;
+     } else
-         mindex = 0; nochk = 0; dp_fcoeffs = 0;
+       ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fd));
-         get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
+   }
-         NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
+   if ( fd0 ) NEXT(fd) = 0;
-         CNVars = homo ? NVars+1 : NVars;
+   fi0 = fd0;
-         if ( ord->id && NVars != ord->nv )
+   setup_arrays(fd0,0,&s);
-                 error("dp_gr_main : invalid order specification");
+   init_stat();
-         initd(ord);
+   x = s;
-         if ( homo ) {
+   reduceall(x,&xx); x = xx;
-                 homogenize_order(ord,NVars,&ord1);
+   for ( r0 = 0, ind0 = 0; x; x = NEXT(x) ) {
-                 for ( fd0 = fi0 = 0, t = BDY(f); t; t = NEXT(t) ) {
+     NEXTNODE(r0,r); dp_load((int)BDY(x),&ps[(int)BDY(x)]);
-                         NEXTNODE(fd0,fd); NEXTNODE(fi0,fi);
+     if ( input_is_dp )
-                         ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fi)); dp_homo((DP)BDY(fi),(DP *)&BDY(fd));
+       BDY(r) = (pointer)ps[(int)BDY(x)];
-                 }
+     else
-                 if ( fd0 ) NEXT(fd) = 0;
+       dtop(CO,vv,ps[(int)BDY(x)],(Obj *)&BDY(r));
-                 if ( fi0 ) NEXT(fi) = 0;
+     NEXTNODE(ind0,ind);
-                 initd(&ord1);
+     STOQ((int)BDY(x),q); BDY(ind) = q;
-         } else {
+   }
-                 for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
+   if ( r0 ) NEXT(r) = 0;
-                         NEXTNODE(fd0,fd); ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fd));
+   if ( ind0 ) NEXT(ind) = 0;
-                 }
+   MKLIST(*rp,r0);
-                 if ( fd0 ) NEXT(fd) = 0;
+   MKLIST(gbindex,ind0);
-                 fi0 = fd0;
-         }
-         if ( modular < 0 ) {
-                 modular = -modular; nochk = 1;
-         }
-         if ( modular )
-                 m = modular > 1 ? modular : lprime[mindex];
-         else
-                 m = 0;
-         makesubst(vc,&subst);
-         setup_arrays(fd0,0,&s);
-         init_stat();
-         while ( 1 ) {
-                 if ( homo ) {
-                         initd(&ord1); CNVars = NVars+1;
-                 }
-                 if ( Print && modular ) {
-                         fprintf(asir_out,"mod= %d, eval = ",m); printsubst(subst);
-                 }
-                 x = gb(s,m,subst);
-                 if ( x ) {
-                         if ( homo ) {
-                                 reducebase_dehomo(x,&xx); x = xx;
-                                 initd(ord); CNVars = NVars;
-                         }
-                         reduceall(x,&xx); x = xx;
-                         if ( modular ) {
-                                 if ( nochk || (membercheck(fi0,x) && gbcheck(x)) )
-                                         break;
-                         } else
-                                 break;
-                 }
-                 if ( modular )
-                         if ( modular > 1 ) {
-                                 *rp = 0; return;
-                         } else
-                                 m = lprime[++mindex];
-                 makesubst(vc,&subst);
-                 psn = length(s);
-                 for ( i = psn; i < pslen; i++ ) {
-                         pss[i] = 0; psh[i] = 0; psc[i] = 0; ps[i] = 0;
-                 }
-         }
-         for ( r0 = 0; x; x = NEXT(x) ) {
-                 NEXTNODE(r0,r); dp_load((int)BDY(x),&ps[(int)BDY(x)]);
-                 dtop(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
-         }
-         if ( r0 ) NEXT(r) = 0;
-         MKLIST(*rp,r0);
-         print_stat();
-         if ( ShowMag )
-                 fprintf(asir_out,"\nMax_mag=%d\n",Max_mag);
  }
- void dp_gr_mod_main(f,v,homo,m,ord,rp)
+ void dp_gr_mod_main(LIST f,LIST v,Num homo,int m,struct order_spec *ord,LIST *rp)
- LIST f,v;
- Num homo;
- int m;
- struct order_spec *ord;
- LIST *rp;
  {
-         struct order_spec ord1;
+   struct order_spec *ord1;
-         VL fv,vv,vc;
+   VL fv,vv,vc;
-         NODE fd,fd0,r,r0,t,x,s,xx;
+   NODE fd,fd0,r,r0,t,x,s,xx;
-         DP a,b,c;
+   DP a,b,c;
+   extern struct oEGT eg_red_mod;
+   int input_is_dp = 0;
-         get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
+   get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
-         NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
+   NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
-         CNVars = homo ? NVars+1 : NVars;
+   CNVars = homo ? NVars+1 : NVars;
-         if ( ord->id && NVars != ord->nv )
+   if ( ord->id && NVars != ord->nv )
-                 error("dp_gr_mod_main : invalid order specification");
+     error("dp_gr_mod_main : invalid order specification");
-         initd(ord);
+   initd(ord);
-         if ( homo ) {
+   if ( homo ) {
-                 for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
+     for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
-                         ptod(CO,vv,(P)BDY(t),&a); dp_homo(a,&b);
+       if ( BDY(t) && OID(BDY(t)) == O_DP ) {
-                         if ( PCoeffs )
+         dp_sort((DP)BDY(t),&a); input_is_dp = 1;
-                                 dp_mod(b,m,0,&c);
+       } else
-                         else
+         ptod(CO,vv,(P)BDY(t),&a);
-                                 _dp_mod(b,m,(NODE)0,&c);
+       dp_homo(a,&b);
-                         if ( c ) {
+       if ( PCoeffs )
-                                 NEXTNODE(fd0,fd); BDY(fd) = (pointer)c;
+         dp_mod(b,m,0,&c);
-                         }
+       else
-                 }
+         _dp_mod(b,m,(NODE)0,&c);
-                 homogenize_order(ord,NVars,&ord1); initd(&ord1);
+       if ( c ) {
-         } else {
+         NEXTNODE(fd0,fd); BDY(fd) = (pointer)c;
-                 for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
+       }
-                         ptod(CO,vv,(P)BDY(t),&b);
+     }
-                         if ( PCoeffs )
+     homogenize_order(ord,NVars,&ord1); initd(ord1);
-                                 dp_mod(b,m,0,&c);
+   } else {
-                         else
+     for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
-                                 _dp_mod(b,m,0,&c);
+       if ( BDY(t) && OID(BDY(t)) == O_DP ) {
-                         if ( c ) {
+         dp_sort((DP)BDY(t),&b); input_is_dp = 1;
-                                 NEXTNODE(fd0,fd); BDY(fd) = (pointer)c;
+       } else
-                         }
+         ptod(CO,vv,(P)BDY(t),&b);
-                 }
+       if ( PCoeffs )
-         }
+         dp_mod(b,m,0,&c);
-         if ( fd0 ) NEXT(fd) = 0;
+       else
-         setup_arrays(fd0,m,&s);
+         _dp_mod(b,m,0,&c);
-         init_stat();
+       if ( c ) {
-         if ( homo ) {
+         NEXTNODE(fd0,fd); BDY(fd) = (pointer)c;
-                 initd(&ord1); CNVars = NVars+1;
+       }
-         }
+     }
-         x = gb_mod(s,m);
+   }
-         if ( homo ) {
+   if ( fd0 ) NEXT(fd) = 0;
-                 reducebase_dehomo(x,&xx); x = xx;
+   setup_arrays(fd0,m,&s);
-                 initd(ord); CNVars = NVars;
+   init_stat();
-         }
+   if ( homo ) {
-         reduceall_mod(x,m,&xx); x = xx;
+     initd(ord1); CNVars = NVars+1;
-         if ( PCoeffs )
+   }
-                 for ( r0 = 0; x; x = NEXT(x) ) {
+ /* init_eg(&eg_red_mod); */
-                         NEXTNODE(r0,r); mdtop(CO,m,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+   x = gb_mod(s,m);
-                 }
+ /* print_eg("Red_mod",&eg_red_mod); */
-         else
+   if ( homo ) {
-                 for ( r0 = 0; x; x = NEXT(x) ) {
+     reducebase_dehomo(x,&xx); x = xx;
-                         NEXTNODE(r0,r); _dtop_mod(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+     initd(ord); CNVars = NVars;
-                 }
+   }
-         print_stat();
+   reduceall_mod(x,m,&xx); x = xx;
-         if ( r0 ) NEXT(r) = 0;
+   if ( PCoeffs )
-         MKLIST(*rp,r0);
+     for ( r0 = 0; x; x = NEXT(x) ) {
+       NEXTNODE(r0,r);
+       if ( input_is_dp )
+         mdtodp(ps[(int)BDY(x)],(DP *)&BDY(r));
+       else
+         mdtop(CO,m,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+     }
+   else
+     for ( r0 = 0; x; x = NEXT(x) ) {
+       NEXTNODE(r0,r);
+       if ( input_is_dp )
+         _mdtodp(ps[(int)BDY(x)],(DP *)&BDY(r));
+       else
+         _dtop_mod(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+     }
+   print_stat();
+   if ( r0 ) NEXT(r) = 0;
+   MKLIST(*rp,r0);
  }
- void dp_f4_main(f,v,ord,rp)
+ void dp_f4_main(LIST f,LIST v,struct order_spec *ord,LIST *rp)
- LIST f,v;
- struct order_spec *ord;
- LIST *rp;
  {
-         int i,mindex,m,nochk;
+   int homogen;
-         struct order_spec ord1;
+   VL fv,vv,vc;
-         VL fv,vv,vc;
+   NODE fd,fd0,r,r0,t,x,s,xx;
-         NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx;
+   int input_is_dp = 0;
-         dp_fcoeffs = 0;
+   dp_fcoeffs = 0;
-         get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
+   get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
-         NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
+   NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
-         CNVars = NVars;
+   CNVars = NVars;
-         if ( ord->id && NVars != ord->nv )
+   if ( ord->id && NVars != ord->nv )
-                 error("dp_f4_main : invalid order specification");
+     error("dp_f4_main : invalid order specification");
-         initd(ord);
+   initd(ord);
-         for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
+   for ( fd0 = 0, t = BDY(f), homogen = 1; t; t = NEXT(t) ) {
-                 NEXTNODE(fd0,fd); ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fd));
+     NEXTNODE(fd0,fd);
-         }
+     if ( BDY(t) && OID(BDY(t)) == O_DP ) {
-         if ( fd0 ) NEXT(fd) = 0;
+       dp_sort((DP)BDY(t),(DP *)&BDY(fd)); input_is_dp = 1;
-         setup_arrays(fd0,0,&s);
+     } else
-         x = gb_f4(s);
+       ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fd));
-         reduceall(x,&xx); x = xx;
+     if ( homogen )
-         for ( r0 = 0; x; x = NEXT(x) ) {
+       homogen = dp_homogeneous(BDY(fd));
-                 NEXTNODE(r0,r); dp_load((int)BDY(x),&ps[(int)BDY(x)]);
+   }
-                 dtop(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+   if ( fd0 ) NEXT(fd) = 0;
-         }
+   setup_arrays(fd0,0,&s);
-         if ( r0 ) NEXT(r) = 0;
+   x = gb_f4(s);
-         MKLIST(*rp,r0);
+   if ( !homogen ) {
+     reduceall(x,&xx); x = xx;
+   }
+   for ( r0 = 0; x; x = NEXT(x) ) {
+     NEXTNODE(r0,r); dp_load((int)BDY(x),&ps[(int)BDY(x)]);
+     if ( input_is_dp )
+       BDY(r) = (pointer)ps[(int)BDY(x)];
+     else
+       dtop(CO,vv,ps[(int)BDY(x)],(Obj *)&BDY(r));
+   }
+   if ( r0 ) NEXT(r) = 0;
+   MKLIST(*rp,r0);
  }
- void dp_f4_mod_main(f,v,m,ord,rp)
+ void dp_f4_mod_main(LIST f,LIST v,int m,struct order_spec *ord,LIST *rp)
- LIST f,v;
- int m;
- struct order_spec *ord;
- LIST *rp;
  {
-         int i;
+   int homogen;
-         struct order_spec ord1;
+   VL fv,vv,vc;
-         VL fv,vv,vc;
+   DP b,c,c1;
-         DP b,c,c1;
+   NODE fd,fd0,r,r0,t,x,s,xx;
-         NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx;
+   int input_is_dp = 0;
-         dp_fcoeffs = 0;
+   dp_fcoeffs = 0;
-         get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
+   get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
-         NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
+   NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
-         CNVars = NVars;
+   CNVars = NVars;
-         if ( ord->id && NVars != ord->nv )
+   if ( ord->id && NVars != ord->nv )
-                 error("dp_f4_mod_main : invalid order specification");
+     error("dp_f4_mod_main : invalid order specification");
-         initd(ord);
+   initd(ord);
-         for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
+   for ( fd0 = 0, t = BDY(f), homogen = 1; t; t = NEXT(t) ) {
-                 ptod(CO,vv,(P)BDY(t),&b);
+     if ( BDY(t) && OID(BDY(t)) == O_DP ) {
-                 _dp_mod(b,m,0,&c);
+       dp_sort((DP)BDY(t),&b); input_is_dp = 1;
-                 _dp_monic(c,m,&c1);
+     } else
-                 if ( c ) {
+       ptod(CO,vv,(P)BDY(t),&b);
-                         NEXTNODE(fd0,fd); BDY(fd) = (pointer)c1;
+     if ( homogen )
-                 }
+       homogen = dp_homogeneous(b);
-         }
+     _dp_mod(b,m,0,&c);
-         if ( fd0 ) NEXT(fd) = 0;
+     _dp_monic(c,m,&c1);
-         setup_arrays(fd0,m,&s);
+     if ( c ) {
-         x = gb_f4_mod(s,m);
+       NEXTNODE(fd0,fd); BDY(fd) = (pointer)c1;
-         reduceall_mod(x,m,&xx); x = xx;
+     }
-         for ( r0 = 0; x; x = NEXT(x) ) {
+   }
-                 NEXTNODE(r0,r); _dtop_mod(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+   if ( fd0 ) NEXT(fd) = 0;
-         }
+   setup_arrays(fd0,m,&s);
-         if ( r0 ) NEXT(r) = 0;
+   init_stat();
-         MKLIST(*rp,r0);
+   if ( do_weyl )
+     x = gb_f4_mod_old(s,m);
+   else
+     x = gb_f4_mod(s,m);
+   if ( !homogen ) {
+     reduceall_mod(x,m,&xx); x = xx;
+   }
+   for ( r0 = 0; x; x = NEXT(x) ) {
+     NEXTNODE(r0,r);
+     if ( input_is_dp )
+       _mdtodp(ps[(int)BDY(x)],(DP *)&BDY(r));
+     else
+       _dtop_mod(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+   }
+   if ( r0 ) NEXT(r) = 0;
+   MKLIST(*rp,r0);
+   print_stat();
  }
- NODE gb_f4(f)
+ NODE gb_f4(NODE f)
- NODE f;
  {
-         int i,j,k,nh,row,col,nv;
+   int i,k,nh,row,col,nv;
-         NODE r,g,gall;
+   NODE r,g,gall;
-         NODE s,s0;
+   NODE s,s0;
-         DP_pairs d,dm,dr,t;
+   DP_pairs d,dm,dr,t;
-         DP h,nf,nf1,f1,f2,f21,f21r,sp,sp1,sd,sdm,tdp;
+   DP nf,nf1,f2,sp,sd,tdp;
-         MP mp,mp0;
+   MP mp,mp0;
-         NODE blist,bt,nt;
+   NODE blist,bt;
-         DL *ht,*at;
+   DL *ht,*at;
-         MAT mat,nm;
+   MAT mat,nm;
-         int *colstat;
+   int *rind,*cind;
-         int *rind,*cind;
+   int rank,nred;
-         int rank,nred;
+   Q dn;
-         Q dn;
+   struct oEGT tmp0,tmp1,eg_split_symb;
-         struct oEGT tmp0,tmp1,tmp2,eg_split_symb,eg_split_elim;
+   extern struct oEGT eg_mod,eg_elim,eg_chrem,eg_gschk,eg_intrat,eg_symb;
-         extern struct oEGT eg_mod,eg_elim,eg_chrem,eg_gschk,eg_intrat,eg_symb;
-         init_eg(&eg_mod); init_eg(&eg_elim); init_eg(&eg_chrem);
+   init_eg(&eg_mod); init_eg(&eg_elim); init_eg(&eg_chrem);
-         init_eg(&eg_gschk); init_eg(&eg_intrat); init_eg(&eg_symb);
+   init_eg(&eg_gschk); init_eg(&eg_intrat); init_eg(&eg_symb);
-         doing_f4 = 1;
+   doing_f4 = 1;
-         for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
+   for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
-                 i = (int)BDY(r);
+     i = (int)BDY(r);
-                 d = updpairs(d,g,i);
+     d = updpairs(d,g,i);
-                 g = updbase(g,i);
+     g = updbase(g,i);
-                 gall = append_one(gall,i);
+     gall = append_one(gall,i);
-         }
+   }
-         if ( gall )
+   if ( gall )
-                 nv = ((DP)ps[(int)BDY(gall)])->nv;
+     nv = ((DP)ps[(int)BDY(gall)])->nv;
-         while ( d ) {
+   while ( d ) {
-                 get_eg(&tmp0);
+     get_eg(&tmp0);
-                 minsugar(d,&dm,&dr); d = dr;
+     minsugar(d,&dm,&dr); d = dr;
-                 if ( Print )
+     if ( DP_Print )
-                         fprintf(asir_out,"sugar=%d\n",dm->sugar);
+       fprintf(asir_out,"sugar=%d\n",dm->sugar);
-                 blist = 0; s0 = 0;
+     blist = 0; s0 = 0;
-                 /* asph : sum of all head terms of spoly */
+     /* asph : sum of all head terms of spoly */
-                 for ( t = dm; t; t = NEXT(t) ) {
+     for ( t = dm; t; t = NEXT(t) ) {
-                         dp_sp(ps[t->dp1],ps[t->dp2],&sp);
+       dp_sp(ps[t->dp1],ps[t->dp2],&sp);
-                         if ( sp ) {
+       if ( sp ) {
-                                 MKNODE(bt,sp,blist); blist = bt;
+         MKNODE(bt,sp,blist); blist = bt;
-                                 s0 = symb_merge(s0,dp_dllist(sp),nv);
+         s0 = symb_merge(s0,dp_dllist(sp),nv);
-                         }
+       }
-                 }
+     }
-                 /* s0 : all the terms appeared in symbolic redunction */
+     /* s0 : all the terms appeared in symbolic redunction */
-                 for ( s = s0, nred = 0; s; s = NEXT(s) ) {
+     for ( s = s0, nred = 0; s; s = NEXT(s) ) {
-                         for ( r = gall; r; r = NEXT(r) )
+       for ( r = gall;  r; r = NEXT(r) )
-                                 if ( _dl_redble(BDY(ps[(int)BDY(r)])->dl,BDY(s),nv) )
+         if ( _dl_redble(BDY(ps[(int)BDY(r)])->dl,BDY(s),nv) )
-                                         break;
+           break;
-                         if ( r ) {
+       if ( r ) {
-                                 dltod(BDY(s),nv,&tdp);
+         dltod(BDY(s),nv,&tdp);
-                                 dp_subd(tdp,ps[(int)BDY(r)],&sd);
+         dp_subd(tdp,ps[(int)BDY(r)],&sd);
-                                 muld(CO,sd,ps[(int)BDY(r)],&f2);
+         muld(CO,sd,ps[(int)BDY(r)],&f2);
-                                 MKNODE(bt,f2,blist); blist = bt;
+         MKNODE(bt,f2,blist); blist = bt;
-                                 s = symb_merge(s,dp_dllist(f2),nv);
+         s = symb_merge(s,dp_dllist(f2),nv);
-                                 nred++;
+         nred++;
-                         }
+       }
-                 }
+     }
-                 /* the first nred polys in blist are reducers */
+     /* the first nred polys in blist are reducers */
-                 /* row = the number of all the polys */
+     /* row = the number of all the polys */
-                 for ( r = blist, row = 0; r; r = NEXT(r), row++ );
+     for ( r = blist, row = 0; r; r = NEXT(r), row++ );
-                 ht = (DL *)MALLOC(nred*sizeof(DL));
+     ht = (DL *)MALLOC(nred*sizeof(DL));
-                 for ( r = blist, i = 0; i < nred; r = NEXT(r), i++ )
+     for ( r = blist, i = 0; i < nred; r = NEXT(r), i++ )
-                         ht[i] = BDY((DP)BDY(r))->dl;
+       ht[i] = BDY((DP)BDY(r))->dl;
-                 for ( s = s0, col = 0; s; s = NEXT(s), col++ );
+     for ( s = s0, col = 0; s; s = NEXT(s), col++ );
-                 at = (DL *)MALLOC(col*sizeof(DL));
+     at = (DL *)MALLOC(col*sizeof(DL));
-                 for ( s = s0, i = 0; i < col; s = NEXT(s), i++ )
+     for ( s = s0, i = 0; i < col; s = NEXT(s), i++ )
-                         at[i] = (DL)BDY(s);
+       at[i] = (DL)BDY(s);
-                 MKMAT(mat,row,col);
+     MKMAT(mat,row,col);
-                 for ( i = 0, r = blist; i < row; r = NEXT(r), i++ )
+     for ( i = 0, r = blist; i < row; r = NEXT(r), i++ )
-                         dp_to_vect(BDY(r),at,(Q *)mat->body[i]);
+       dp_to_vect(BDY(r),at,(Q *)mat->body[i]);
-                 get_eg(&tmp1); add_eg(&eg_symb,&tmp0,&tmp1);
+     get_eg(&tmp1); add_eg(&eg_symb,&tmp0,&tmp1);
-                 init_eg(&eg_split_symb); add_eg(&eg_split_symb,&tmp0,&tmp1);
+     init_eg(&eg_split_symb); add_eg(&eg_split_symb,&tmp0,&tmp1);
-                 if ( Print ) {
+     if ( DP_Print ) {
-                         print_eg("Symb",&eg_split_symb);
+       print_eg("Symb",&eg_split_symb);
-                         fprintf(asir_out,"mat : %d x %d",row,col);
+       fprintf(asir_out,"mat : %d x %d",row,col);
-                         fflush(asir_out);
+       fflush(asir_out);
-                 }
+     }
  #if 0
-                 rank = generic_gauss_elim_hensel(mat,&nm,&dn,&rind,&cind);
+     rank = generic_gauss_elim_hensel(mat,&nm,&dn,&rind,&cind);
  #else
-                 rank = generic_gauss_elim(mat,&nm,&dn,&rind,&cind);
+     rank = generic_gauss_elim(mat,&nm,&dn,&rind,&cind);
  #endif
-                 if ( Print )
+     if ( DP_Print )
-                         fprintf(asir_out,"done rank = %d\n",rank,row,col);
+       fprintf(asir_out,"done rank = %d\n",rank,row,col);
-                 for ( i = 0; i < rank; i++ ) {
+     for ( i = 0; i < rank; i++ ) {
-                         for ( k = 0; k < nred; k++ )
+       for ( k = 0; k < nred; k++ )
-                                 if ( !cmpdl(nv,at[rind[i]],ht[k]) )
+         if ( !cmpdl(nv,at[rind[i]],ht[k]) )
-                                         break;
+           break;
-                         if ( k == nred ) {
+       if ( k == nred ) {
-                                 /* this is a new base */
+         /* this is a new base */
-                                 mp0 = 0;
+         mp0 = 0;
-                                 NEXTMP(mp0,mp); mp->dl = at[rind[i]]; mp->c = (P)dn;
+         NEXTMP(mp0,mp); mp->dl = at[rind[i]]; mp->c = (Obj)dn;
-                                 for ( k = 0; k < col-rank; k++ )
+         for ( k = 0; k < col-rank; k++ )
-                                         if ( nm->body[i][k] ) {
+           if ( nm->body[i][k] ) {
-                                                 NEXTMP(mp0,mp); mp->dl = at[cind[k]];
+             NEXTMP(mp0,mp); mp->dl = at[cind[k]];
-                                                 mp->c = (P)nm->body[i][k];
+             mp->c = (Obj)nm->body[i][k];
-                                         }
+           }
-                                 NEXT(mp) = 0;
+         NEXT(mp) = 0;
-                                 MKDP(nv,mp0,nf); nf->sugar = dm->sugar;
+         MKDP(nv,mp0,nf); nf->sugar = dm->sugar;
-                                 dp_ptozp(nf,&nf1);
+         dp_ptozp(nf,&nf1);
-                                 nh = newps(nf1,0,0);
+         nh = newps(nf1,0,0);
-                                 d = updpairs(d,g,nh);
+         d = updpairs(d,g,nh);
-                                 g = updbase(g,nh);
+         g = updbase(g,nh);
-                                 gall = append_one(gall,nh);
+         gall = append_one(gall,nh);
-                         }
+       }
-                 }
+     }
-         }
+   }
-         if ( Print ) {
+   if ( DP_Print ) {
-                 print_eg("Symb",&eg_symb);
+     print_eg("Symb",&eg_symb);
-                 print_eg("Mod",&eg_mod); print_eg("GaussElim",&eg_elim);
+     print_eg("Mod",&eg_mod); print_eg("GaussElim",&eg_elim);
-                 print_eg("ChRem",&eg_chrem); print_eg("IntToRat",&eg_intrat);
+     print_eg("ChRem",&eg_chrem); print_eg("IntToRat",&eg_intrat);
-                 print_eg("Check",&eg_gschk);
+     print_eg("Check",&eg_gschk);
-         }
+   }
-         return g;
+   return g;
  }
  /* initial bases are monic */
- NODE gb_f4_mod(f,m)
+ unsigned int **psca;
- NODE f;
+ GeoBucket create_bucket();
- int m;
+ DL remove_head_bucket(GeoBucket,int);
+ NODE gb_f4_mod(NODE f,int m)
  {
-         int i,j,k,nh,row,col,nv;
+   int i,j,k,nh,row,col,nv;
-         NODE r,g,gall;
+   NODE r,g,gall;
-         NODE s,s0;
+   NODE s,s0;
-         DP_pairs d,dm,dr,t;
+   DP_pairs d,dm,dr,t;
-         DP h,nf,f1,f2,f21,f21r,sp,sp1,sd,sdm,tdp;
+   DP nf,sp,sd,tdp;
-         MP mp,mp0;
+   MP mp,mp0;
-         NODE blist,bt,nt;
+   NODE blist,bt,bt1,dt;
-         DL *ht,*at,*st;
+   DL *at,*st;
-         int **spmat,**redmat;
+   int **spmat;
-         int *colstat,*w;
+   CDP *redmat;
-         int rank,nred,nsp,nonzero,spcol;
+   int *colstat,*w,*w1;
-         int *indred,*isred,*ri;
+   int rank,nred,nsp,nsp0,nonzero,spcol;
-         struct oEGT tmp0,tmp1,tmp2,eg_split_symb,eg_split_elim1,eg_split_elim2;
+   int *indred,*isred;
-         extern struct oEGT eg_symb,eg_elim1,eg_elim2;
+   CDP ri;
+   int pscalen;
+   GeoBucket bucket;
+   DL head;
+   struct oEGT tmp0,tmp1,eg_split_symb,eg_split_conv,eg_split_elim1,eg_split_elim2;
+   extern struct oEGT eg_symb,eg_conv,eg_elim1,eg_elim2;
-         init_eg(&eg_symb); init_eg(&eg_elim1); init_eg(&eg_elim2);
+   /* initialize coeffcient array list of ps[] */
-         for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
+   pscalen = pslen;
-                 i = (int)BDY(r);
+   psca = (unsigned int **)MALLOC(pscalen*sizeof(unsigned int *));
-                 d = updpairs(d,g,i);
-                 g = updbase(g,i);
-                 gall = append_one(gall,i);
-         }
-         if ( gall )
-                 nv = ((DP)ps[(int)BDY(gall)])->nv;
-         while ( d ) {
-                 get_eg(&tmp0);
-                 minsugar(d,&dm,&dr); d = dr;
-                 if ( Print )
-                         fprintf(asir_out,"sugar=%d\n",dm->sugar);
-                 blist = 0; s0 = 0;
-                 /* asph : sum of all head terms of spoly */
-                 for ( t = dm; t; t = NEXT(t) ) {
-                         _dp_sp_mod(ps[t->dp1],ps[t->dp2],m,&sp);
-                         if ( sp ) {
-                                 MKNODE(bt,sp,blist); blist = bt;
-                                 s0 = symb_merge(s0,dp_dllist(sp),nv);
-                         }
-                 }
-                 /* s0 : all the terms appeared in symbolic redunction */
-                 for ( s = s0, nred = 0; s; s = NEXT(s) ) {
-                         for ( r = gall; r; r = NEXT(r) )
-                                 if ( _dl_redble(BDY(ps[(int)BDY(r)])->dl,BDY(s),nv) )
-                                         break;
-                         if ( r ) {
-                                 dltod(BDY(s),nv,&tdp);
-                                 dp_subd(tdp,ps[(int)BDY(r)],&sd);
-                                 _dp_mod(sd,m,0,&sdm);
-                                 _mulmd(CO,m,sdm,ps[(int)BDY(r)],&f2);
-                                 MKNODE(bt,f2,blist); blist = bt;
-                                 s = symb_merge(s,dp_dllist(f2),nv);
-                                 nred++;
-                         }
-                 }
-                 get_eg(&tmp1); add_eg(&eg_symb,&tmp0,&tmp1);
-                 init_eg(&eg_split_symb); add_eg(&eg_split_symb,&tmp0,&tmp1);
-                 /* the first nred polys in blist are reducers */
+   init_eg(&eg_symb); init_eg(&eg_conv); init_eg(&eg_elim1); init_eg(&eg_elim2);
-                 /* row = the number of all the polys */
+   for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
-                 for ( r = blist, row = 0; r; r = NEXT(r), row++ );
+     i = (int)BDY(r);
+     d = updpairs(d,g,i);
+     g = updbase(g,i);
+     gall = append_one(gall,i);
+     dptoca(ps[i],&psca[i]);
+   }
+   if ( gall )
+     nv = ((DP)ps[(int)BDY(gall)])->nv;
+   while ( d ) {
+     get_eg(&tmp0);
+     minsugar(d,&dm,&dr); d = dr;
+     if ( DP_Print )
+       fprintf(asir_out,"sugar=%d\n",dm->sugar);
+     blist = 0;
+     bucket = create_bucket();
+     /* asph : sum of all head terms of spoly */
+     for ( t = dm; t; t = NEXT(t) ) {
+       _dp_sp_mod(ps[t->dp1],ps[t->dp2],m,&sp);
+ /*      fprintf(stderr,"splen=%d-",dp_nt(sp)); */
+       if ( sp ) {
+         MKNODE(bt,sp,blist); blist = bt;
+         add_bucket(bucket,dp_dllist(sp),nv);
+ /*        fprintf(stderr,"%d-",length(s0)); */
+       }
+     }
+ #if 0
+     if ( DP_Print )
+       fprintf(asir_out,"initial spmat : %d x %d ",length(blist),length(s0));
+ #endif
+     /* s0 : all the terms appeared in symbolic reduction */
+     nred = 0;
+     s0 = 0;
+     while ( 1 ) {
+       head = remove_head_bucket(bucket,nv);
+       if ( !head ) break;
+       else {
+         NEXTNODE(s0,s);
+         BDY(s) = (pointer)head;
+       }
+       for ( r = gall;  r; r = NEXT(r) )
+         if ( _dl_redble(BDY(ps[(int)BDY(r)])->dl,head,nv) )
+           break;
+       if ( r ) {
+         dltod(head,nv,&tdp);
+         dp_subd(tdp,ps[(int)BDY(r)],&sd);
+         dt = mul_dllist(BDY(sd)->dl,ps[(int)BDY(r)]);
+         add_bucket(bucket,NEXT(dt),nv);
+ /*        fprintf(stderr,"[%d]",length(dt)); */
+         /* list of [t,f] */
+         bt1 = mknode(2,BDY(sd)->dl,BDY(r));
+         MKNODE(bt,bt1,blist); blist = bt;
+ /*        fprintf(stderr,"%d-",length(s0));  */
+         nred++;
+       }
+     }
+     if ( s0 ) NEXT(s) = 0;
+ /*    fprintf(stderr,"\n"); */
+     get_eg(&tmp1); add_eg(&eg_symb,&tmp0,&tmp1);
+     init_eg(&eg_split_symb); add_eg(&eg_split_symb,&tmp0,&tmp1);
-                 /* head terms of reducers */
+     if ( DP_Print )
-                 ht = (DL *)MALLOC(nred*sizeof(DL));
+       fprintf(asir_out,"number of reducers : %d\n",nred);
-                 for ( r = blist, i = 0; i < nred; r = NEXT(r), i++ )
-                         ht[i] = BDY((DP)BDY(r))->dl;
-                 /* col = number of all terms */
+     get_eg(&tmp0);
-                 for ( s = s0, col = 0; s; s = NEXT(s), col++ );
+     /* the first nred polys in blist are reducers */
+     /* row = the number of all the polys */
+     for ( r = blist, row = 0; r; r = NEXT(r), row++ );
-                 /* head terms of all terms */
+     /* col = number of all terms */
-                 at = (DL *)MALLOC(col*sizeof(DL));
+     for ( s = s0, col = 0; s; s = NEXT(s), col++ );
-                 for ( s = s0, i = 0; i < col; s = NEXT(s), i++ )
-                         at[i] = (DL)BDY(s);
-                 /* store coefficients separately in spmat and redmat */
+     /* head terms of all terms */
-                 nsp = row-nred;
+     at = (DL *)MALLOC(col*sizeof(DL));
+     for ( s = s0, i = 0; i < col; s = NEXT(s), i++ )
+       at[i] = (DL)BDY(s);
-                 /* reducer matrix */
+     /* store coefficients separately in spmat and redmat */
-                 redmat = (int **)almat(nred,col);
+     nsp = row-nred;
-                 for ( i = 0, r = blist; i < nred; r = NEXT(r), i++ )
-                         _dpmod_to_vect(BDY(r),at,redmat[i]);
-                 /* XXX */
- /*              reduce_reducers_mod(redmat,nred,col,m); */
-                 /* register the position of the head term */
-                 indred = (int *)MALLOC(nred*sizeof(int));
-                 bzero(indred,nred*sizeof(int));
-                 isred = (int *)MALLOC(col*sizeof(int));
-                 bzero(isred,col*sizeof(int));
-                 for ( i = 0; i < nred; i++ ) {
-                         ri = redmat[i];
-                         for ( j = 0; j < col && !ri[j]; j++ );
-                         indred[i] = j;
-                         isred[j] = 1;
-                 }
-                 spcol = col-nred;
+     /* reducer matrix */
-                 /* head terms not in ht */
+     /* indred : register the position of the head term */
-                 st = (DL *)MALLOC(spcol*sizeof(DL));
+     redmat = (CDP *)MALLOC(nred*sizeof(CDP));
-                 for ( j = 0, k = 0; j < col; j++ )
+     for ( i = 0, r = blist; i < nred; r = NEXT(r), i++ )
-                         if ( !isred[j] )
+       _tf_to_vect_compress(BDY(r),at,&redmat[i]);
-                                 st[k++] = at[j];
-                 /* spoly matrix; stored in reduced form; terms in ht[] are omitted */
+     /* register the position of the head term */
-                 spmat = almat(nsp,spcol);
+     indred = (int *)MALLOC_ATOMIC(nred*sizeof(int));
-                 w = (int *)MALLOC(col*sizeof(int));
+     bzero(indred,nred*sizeof(int));
-                 for ( ; i < row; r = NEXT(r), i++ ) {
+     isred = (int *)MALLOC_ATOMIC(col*sizeof(int));
-                         bzero(w,col*sizeof(int));
+     bzero(isred,col*sizeof(int));
-                         _dpmod_to_vect(BDY(r),at,w);
+     for ( i = 0; i < nred; i++ ) {
-                         reduce_sp_by_red_mod(w,redmat,indred,nred,col,m);
+       ri = redmat[i];
-                         for ( j = 0, k = 0; j < col; j++ )
+       indred[i] = ri->body[0];
-                                 if ( !isred[j] )
+       isred[indred[i]] = 1;
-                                         spmat[i-nred][k++] = w[j];
+     }
-                 }
-                 get_eg(&tmp0); add_eg(&eg_elim1,&tmp1,&tmp0);
+     spcol = col-nred;
-                 init_eg(&eg_split_elim1); add_eg(&eg_split_elim1,&tmp1,&tmp0);
+     /* head terms not in ht */
+     st = (DL *)MALLOC(spcol*sizeof(DL));
+     for ( j = 0, k = 0; j < col; j++ )
+       if ( !isred[j] )
+         st[k++] = at[j];
+     get_eg(&tmp1); add_eg(&eg_conv,&tmp0,&tmp1);
+     init_eg(&eg_split_conv); add_eg(&eg_split_conv,&tmp0,&tmp1);
-                 colstat = (int *)MALLOC_ATOMIC(spcol*sizeof(int));
+     get_eg(&tmp1);
-                 for ( i = 0, nonzero=0; i < nsp; i++ )
+     /* spoly matrix; stored in reduced form; terms in ht[] are omitted */
-                         for ( j = 0; j < spcol; j++ )
+     spmat = (int **)MALLOC(nsp*sizeof(int *));
-                                 if ( spmat[i][j] )
+     w = (int *)MALLOC_ATOMIC(col*sizeof(int));
-                                         nonzero++;
-                 if ( Print )
-                         fprintf(asir_out,"spmat : %d x %d (nonzero=%f%%)...",
-                                 nsp,spcol,((double)nonzero*100)/(nsp*spcol));
-                 rank = generic_gauss_elim_mod(spmat,nsp,spcol,m,colstat);
-                 get_eg(&tmp1); add_eg(&eg_elim2,&tmp0,&tmp1);
+     /* skip reducers in blist */
-                 init_eg(&eg_split_elim2); add_eg(&eg_split_elim2,&tmp0,&tmp1);
+     for ( i = 0, r = blist; i < nred; r = NEXT(r), i++ );
+     for ( i = 0; r; r = NEXT(r) ) {
+       bzero(w,col*sizeof(int));
+       _dpmod_to_vect(BDY(r),at,w);
+       reduce_sp_by_red_mod_compress(w,redmat,indred,nred,col,m);
+       for ( j = 0; j < col; j++ )
+         if ( w[j] )
+           break;
+       if ( j < col ) {
+         w1 = (int *)MALLOC_ATOMIC(spcol*sizeof(int));
+         for ( j = 0, k = 0; j < col; j++ )
+           if ( !isred[j] )
+             w1[k++] = w[j];
+         spmat[i] = w1;
+         i++;
+       }
+     }
+     /* update nsp */
+     nsp0 = nsp;
+     nsp = i;
-                 if ( Print ) {
+     /* XXX free redmat explicitly */
-                         fprintf(asir_out,"done rank = %d\n",rank,row,col);
+     for ( k = 0; k < nred; k++ ) {
-                         print_eg("Symb",&eg_split_symb);
+       GCFREE(BDY(redmat[k]));
-                         print_eg("Elim1",&eg_split_elim1);
+       GCFREE(redmat[k]);
-                         print_eg("Elim2",&eg_split_elim2);
+     }
-                         fprintf(asir_out,"\n");
-                 }
-                 for ( j = 0, i = 0; j < spcol; j++ )
-                         if ( colstat[j] ) {
-                                 mp0 = 0;
-                                 NEXTMP(mp0,mp); mp->dl = st[j]; mp->c = STOI(1);
-                                 for ( k = j+1; k < spcol; k++ )
-                                         if ( !colstat[k] && spmat[i][k] ) {
-                                                 NEXTMP(mp0,mp); mp->dl = st[k];
-                                                 mp->c = STOI(spmat[i][k]);
-                                 }
-                                 NEXT(mp) = 0;
-                                 MKDP(nv,mp0,nf); nf->sugar = dm->sugar;
-                                 nh = newps_mod(nf,m);
-                                 d = updpairs(d,g,nh);
-                                 g = updbase(g,nh);
-                                 gall = append_one(gall,nh);
-                                 i++;
-                         }
-         }
-         if ( Print ) {
-                 print_eg("Symb",&eg_symb);
-                 print_eg("Elim1",&eg_elim1);
-                 print_eg("Elim2",&eg_elim2);
-                 fflush(asir_out);
-         }
-         return g;
- }
- int DPPlength(n)
+     get_eg(&tmp0); add_eg(&eg_elim1,&tmp1,&tmp0);
- DP_pairs n;
+     init_eg(&eg_split_elim1); add_eg(&eg_split_elim1,&tmp1,&tmp0);
- {
-         int i;
-         for ( i = 0; n; n = NEXT(n), i++ );
+     colstat = (int *)MALLOC_ATOMIC(spcol*sizeof(int));
-         return i;
+     bzero(colstat,spcol*sizeof(int));
- }
+     for ( i = 0, nonzero=0; i < nsp; i++ )
+       for ( j = 0; j < spcol; j++ )
+         if ( spmat[i][j] )
+           nonzero++;
+     if ( DP_Print && nsp )
+       fprintf(asir_out,"spmat : %d x %d (nonzero=%f%%)...",
+         nsp,spcol,((double)nonzero*100)/(nsp*spcol));
+     if ( nsp )
+       rank = generic_gauss_elim_mod(spmat,nsp,spcol,m,colstat);
+     else
+       rank = 0;
+     get_eg(&tmp1); add_eg(&eg_elim2,&tmp0,&tmp1);
+     init_eg(&eg_split_elim2); add_eg(&eg_split_elim2,&tmp0,&tmp1);
- void printdl(dl)
+     if ( DP_Print ) {
- DL dl;
+       fprintf(asir_out,"done rank = %d\n",rank,row,col);
- {
+       print_eg("Symb",&eg_split_symb);
-         int i;
+       print_eg("Conv",&eg_split_conv);
+       print_eg("Elim1",&eg_split_elim1);
+       print_eg("Elim2",&eg_split_elim2);
+       fprintf(asir_out,"\n");
+     }
-         fprintf(asir_out,"<<");
+     NZR += rank;
-         for ( i = 0; i < CNVars-1; i++ )
+     ZR += nsp0-rank;
-                 fprintf(asir_out,"%d,",dl->d[i]);
-         fprintf(asir_out,"%d>>",dl->d[i]);
- }
- void pltovl(l,vl)
+     if ( !rank )
- LIST l;
+       continue;
- VL *vl;
- {
-         NODE n;
-         VL r,r0;
-         n = BDY(l);
+     for ( j = 0, i = 0; j < spcol; j++ )
-         for ( r0 = 0; n; n = NEXT(n) ) {
+       if ( colstat[j] ) {
-                 NEXTVL(r0,r); r->v = VR((P)BDY(n));
+         mp0 = 0;
-         }
+         NEXTMP(mp0,mp); mp->dl = st[j]; mp->c = (Obj)STOI(1);
-         if ( r0 ) NEXT(r) = 0;
+         for ( k = j+1; k < spcol; k++ )
-         *vl = r0;
+           if ( !colstat[k] && spmat[i][k] ) {
+             NEXTMP(mp0,mp); mp->dl = st[k];
+             mp->c = (Obj)STOI(spmat[i][k]);
+         }
+         NEXT(mp) = 0;
+         MKDP(nv,mp0,nf); nf->sugar = dm->sugar;
+         nh = newps_mod(nf,m);
+         if ( nh == pscalen ) {
+           psca = (unsigned int **)
+             REALLOC(psca,2*pscalen*sizeof(unsigned int *));
+           pscalen *= 2;
+         }
+         dptoca(ps[nh],&psca[nh]);
+         d = updpairs(d,g,nh);
+         g = updbase(g,nh);
+         gall = append_one(gall,nh);
+         i++;
+       }
+     /* XXX free spmat[] explicitly */
+     for ( j = 0; j < nsp; j++ ) {
+       GCFREE(spmat[j]);
+     }
+   }
+   if ( DP_Print ) {
+     print_eg("Symb",&eg_symb);
+     print_eg("Conv",&eg_conv);
+     print_eg("Elim1",&eg_elim1);
+     print_eg("Elim2",&eg_elim2);
+     fflush(asir_out);
+   }
+   return g;
  }
- void makesubst(v,s)
+ NODE gb_f4_mod_old(NODE f,int m)
- VL v;
- NODE *s;
  {
-         NODE r,r0;
+   int i,j,k,nh,row,col,nv;
-         Q q;
+   NODE r,g,gall;
-         unsigned int n;
+   NODE s,s0;
+   DP_pairs d,dm,dr,t;
+   DP nf,f2,sp,sd,sdm,tdp;
+   MP mp,mp0;
+   NODE blist,bt;
+   DL *ht,*at,*st;
+   int **spmat,**redmat;
+   int *colstat,*w;
+   int rank,nred,nsp,nonzero,spcol;
+   int *indred,*isred,*ri;
+   struct oEGT tmp0,tmp1,eg_split_symb,eg_split_elim1,eg_split_elim2;
+   extern struct oEGT eg_symb,eg_elim1,eg_elim2;
-         for ( r0 = 0; v; v = NEXT(v) ) {
+   init_eg(&eg_symb); init_eg(&eg_elim1); init_eg(&eg_elim2);
-                 NEXTNODE(r0,r); BDY(r) = (pointer)v->v;
+   for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
- #if defined(_PA_RISC1_1)
+     i = (int)BDY(r);
-                 n = mrand48()&BMASK; UTOQ(n,q);
+     d = updpairs(d,g,i);
- #else
+     g = updbase(g,i);
-                 n = random(); UTOQ(n,q);
+     gall = append_one(gall,i);
- #endif
+   }
-                 NEXTNODE(r0,r); BDY(r) = (pointer)q;
+   if ( gall )
-         }
+     nv = ((DP)ps[(int)BDY(gall)])->nv;
-         if ( r0 ) NEXT(r) = 0;
+   while ( d ) {
-         *s = r0;
+     get_eg(&tmp0);
- }
+     minsugar(d,&dm,&dr); d = dr;
+     if ( DP_Print )
+       fprintf(asir_out,"sugar=%d\n",dm->sugar);
+     blist = 0; s0 = 0;
+     /* asph : sum of all head terms of spoly */
+     for ( t = dm; t; t = NEXT(t) ) {
+       _dp_sp_mod(ps[t->dp1],ps[t->dp2],m,&sp);
+       if ( sp ) {
+         MKNODE(bt,sp,blist); blist = bt;
+         s0 = symb_merge(s0,dp_dllist(sp),nv);
+       }
+     }
+     /* s0 : all the terms appeared in symbolic redunction */
+     for ( s = s0, nred = 0; s; s = NEXT(s) ) {
+       for ( r = gall;  r; r = NEXT(r) )
+         if ( _dl_redble(BDY(ps[(int)BDY(r)])->dl,BDY(s),nv) )
+           break;
+       if ( r ) {
+         dltod(BDY(s),nv,&tdp);
+         dp_subd(tdp,ps[(int)BDY(r)],&sd);
+         _dp_mod(sd,m,0,&sdm);
+         mulmd_dup(m,sdm,ps[(int)BDY(r)],&f2);
+         MKNODE(bt,f2,blist); blist = bt;
+         s = symb_merge(s,dp_dllist(f2),nv);
+         nred++;
+       }
+     }
+     get_eg(&tmp1); add_eg(&eg_symb,&tmp0,&tmp1);
+     init_eg(&eg_split_symb); add_eg(&eg_split_symb,&tmp0,&tmp1);
- void printsubst(s)
+     /* the first nred polys in blist are reducers */
- NODE s;
+     /* row = the number of all the polys */
- {
+     for ( r = blist, row = 0; r; r = NEXT(r), row++ );
-         fputc('[',asir_out);
-         while ( s ) {
-                 printv(CO,(V)BDY(s)); s = NEXT(s);
-                 fprintf(asir_out,"->%d",QTOS((Q)BDY(s)));
-                 if ( NEXT(s) ) {
-                         fputc(',',asir_out); s = NEXT(s);
-                 } else
-                         break;
-         }
-         fprintf(asir_out,"]\n"); return;
- }
- void vlminus(v,w,d)
+     /* head terms of reducers */
- VL v,w,*d;
+     ht = (DL *)MALLOC(nred*sizeof(DL));
- {
+     for ( r = blist, i = 0; i < nred; r = NEXT(r), i++ )
-         int i,j,n,m;
+       ht[i] = BDY((DP)BDY(r))->dl;
-         V *va,*wa;
-         V a;
-         VL r,r0;
-         VL t;
-         for ( n = 0, t = v; t; t = NEXT(t), n++ );
+     /* col = number of all terms */
-         va = (V *)ALLOCA(n*sizeof(V));
+     for ( s = s0, col = 0; s; s = NEXT(s), col++ );
-         for ( i = 0, t = v; t; t = NEXT(t), i++ )
-                 va[i] = t->v;
-         for ( m = 0, t = w; t; t = NEXT(t), m++ );
-         wa = (V *)ALLOCA(m*sizeof(V));
-         for ( i = 0, t = w; t; t = NEXT(t), i++ )
-                 wa[i] = t->v;
-         for ( i = 0; i < n; i++ ) {
-                 a = va[i];
-                 for ( j = 0; j < m; j++ )
-                         if ( a == wa[j] )
-                                 break;
-                 if ( j < m )
-                         va[i] = 0;
-         }
-         for ( r0 = 0, i = 0; i < n; i++ )
-                 if ( va[i] ) { NEXTVL(r0,r); r->v = va[i];      }
-         if ( r0 ) NEXT(r) = 0;
-         *d = r0;
- }
- int validhc(a,m,s)
+     /* head terms of all terms */
- P a;
+     at = (DL *)MALLOC(col*sizeof(DL));
- int m;
+     for ( s = s0, i = 0; i < col; s = NEXT(s), i++ )
- NODE s;
+       at[i] = (DL)BDY(s);
- {
-         P c,c1;
-         V v;
-         if ( !a )
+     /* store coefficients separately in spmat and redmat */
-                 return 0;
+     nsp = row-nred;
-         for ( c = a; s; s = NEXT(s) ) {
-                 v = (V)BDY(s); s = NEXT(s);
-                 substp(CO,c,v,(P)BDY(s),&c1); c = c1;
-         }
-         ptomp(m,c,&c1);
-         return c1 ? 1 : 0;
- }
- void setup_arrays(f,m,r)
+     /* reducer matrix */
- NODE f,*r;
+     redmat = (int **)almat(nred,col);
- int m;
+     for ( i = 0, r = blist; i < nred; r = NEXT(r), i++ )
- {
+       _dpmod_to_vect(BDY(r),at,redmat[i]);
-         int i;
+     /* XXX */
-         NODE s,s0,f0;
+ /*    reduce_reducers_mod(redmat,nred,col,m); */
+     /* register the position of the head term */
+     indred = (int *)MALLOC(nred*sizeof(int));
+     bzero(indred,nred*sizeof(int));
+     isred = (int *)MALLOC(col*sizeof(int));
+     bzero(isred,col*sizeof(int));
+     for ( i = 0; i < nred; i++ ) {
+       ri = redmat[i];
+       for ( j = 0; j < col && !ri[j]; j++ );
+       indred[i] = j;
+       isred[j] = 1;
+     }
-         f0 = f = NODE_sortb(f,1);
+     spcol = col-nred;
-         psn = length(f); pslen = 2*psn;
+     /* head terms not in ht */
-         ps = (DP *)MALLOC(pslen*sizeof(DP));
+     st = (DL *)MALLOC(spcol*sizeof(DL));
-         psh = (DL *)MALLOC(pslen*sizeof(DL));
+     for ( j = 0, k = 0; j < col; j++ )
-         pss = (int *)MALLOC(pslen*sizeof(int));
+       if ( !isred[j] )
-         psc = (P *)MALLOC(pslen*sizeof(P));
+         st[k++] = at[j];
-         for ( i = 0; i < psn; i++, f = NEXT(f) ) {
-                 prim_part((DP)BDY(f),m,&ps[i]);
-                 if ( Demand )
-                         dp_save(i,(Obj)ps[i],0);
-                 psh[i] = BDY(ps[i])->dl;
-                 pss[i] = ps[i]->sugar;
-                 psc[i] = BDY(ps[i])->c;
-         }
-         if ( GenTrace && (OXCheck >= 0) ) {
-                 Q q;
-                 STRING fname;
-                 LIST input;
-                 NODE arg;
-                 Obj dmy;
-                 STOQ(OXCheck,q);
+     /* spoly matrix; stored in reduced form; terms in ht[] are omitted */
-                 MKSTR(fname,"register_input");
+     spmat = almat(nsp,spcol);
-                 MKLIST(input,f0);
+     w = (int *)MALLOC(col*sizeof(int));
-                 arg = mknode(3,q,fname,input);
+     for ( ; i < row; r = NEXT(r), i++ ) {
-                 Pox_cmo_rpc(arg,&dmy);
+       bzero(w,col*sizeof(int));
-         }
+       _dpmod_to_vect(BDY(r),at,w);
-         for ( s0 = 0, i = 0; i < psn; i++ ) {
+       reduce_sp_by_red_mod(w,redmat,indred,nred,col,m);
-                 NEXTNODE(s0,s); BDY(s) = (pointer)i;
+       for ( j = 0, k = 0; j < col; j++ )
-         }
+         if ( !isred[j] )
-         if ( s0 ) NEXT(s) = 0;
+           spmat[i-nred][k++] = w[j];
-         *r = s0;
+     }
- }
- void prim_part(f,m,r)
+     get_eg(&tmp0); add_eg(&eg_elim1,&tmp1,&tmp0);
- DP f,*r;
+     init_eg(&eg_split_elim1); add_eg(&eg_split_elim1,&tmp1,&tmp0);
- int m;
- {
-         P d,t;
-         if ( m > 0 ) {
+     colstat = (int *)MALLOC_ATOMIC(spcol*sizeof(int));
-                 if ( PCoeffs )
+     for ( i = 0, nonzero=0; i < nsp; i++ )
-                         dp_prim_mod(f,m,r);
+       for ( j = 0; j < spcol; j++ )
-                 else
+         if ( spmat[i][j] )
-                         *r = f;
+           nonzero++;
-         } else {
+     if ( DP_Print && nsp )
-                 if ( dp_fcoeffs )
+       fprintf(asir_out,"spmat : %d x %d (nonzero=%f%%)...",
-                         *r = f;
+         nsp,spcol,((double)nonzero*100)/(nsp*spcol));
-                 else if ( PCoeffs )
+     if ( nsp )
-                         dp_prim(f,r);
+       rank = generic_gauss_elim_mod(spmat,nsp,spcol,m,colstat);
-                 else
+     else
-                         dp_ptozp(f,r);
+       rank = 0;
-                 if ( GenTrace && TraceList ) {
+     get_eg(&tmp1); add_eg(&eg_elim2,&tmp0,&tmp1);
-                         divsp(CO,BDY(f)->c,BDY(*r)->c,&d);
+     init_eg(&eg_split_elim2); add_eg(&eg_split_elim2,&tmp0,&tmp1);
-                         mulp(CO,(P)ARG3(BDY((LIST)BDY(TraceList))),d,&t);
-                         ARG3(BDY((LIST)BDY(TraceList))) = t;
+     if ( DP_Print ) {
-                 }
+       fprintf(asir_out,"done rank = %d\n",rank,row,col);
-         }
+       print_eg("Symb",&eg_split_symb);
+       print_eg("Elim1",&eg_split_elim1);
+       print_eg("Elim2",&eg_split_elim2);
+       fprintf(asir_out,"\n");
+     }
+     for ( j = 0, i = 0; j < spcol; j++ )
+       if ( colstat[j] ) {
+         mp0 = 0;
+         NEXTMP(mp0,mp); mp->dl = st[j]; mp->c = (Obj)STOI(1);
+         for ( k = j+1; k < spcol; k++ )
+           if ( !colstat[k] && spmat[i][k] ) {
+             NEXTMP(mp0,mp); mp->dl = st[k];
+             mp->c = (Obj)STOI(spmat[i][k]);
+         }
+         NEXT(mp) = 0;
+         MKDP(nv,mp0,nf); nf->sugar = dm->sugar;
+         nh = newps_mod(nf,m);
+         d = updpairs(d,g,nh);
+         g = updbase(g,nh);
+         gall = append_one(gall,nh);
+         i++;
+       }
+   }
+   if ( DP_Print ) {
+     print_eg("Symb",&eg_symb);
+     print_eg("Elim1",&eg_elim1);
+     print_eg("Elim2",&eg_elim2);
+     fflush(asir_out);
+   }
+   return g;
  }
- NODE /* of DP */ NODE_sortb_insert( newdp, nd, dec )
+ int DPPlength(DP_pairs n)
- DP newdp;
- NODE /* of DP */ nd;
- int dec;
  {
-         register NODE last, p;
+   int i;
-         register DL newdl = BDY(newdp)->dl;
-         register int (*cmpfun)() = cmpdl, nv = CNVars;
+   for ( i = 0; n; n = NEXT(n), i++ );
-         NODE newnd;
+   return i;
-         int sgn = dec ? 1 : -1;
-         MKNODE( newnd, newdp, 0 );
-         if ( !(last = nd) || sgn*(*cmpfun)( nv, newdl, BDY((DP) BDY(last))->dl ) > 0 ) {
-                 NEXT(newnd) = last;
-                 return newnd;
-         }
-         for ( ; p = NEXT(last); last = p )
-                 if ( sgn*(*cmpfun)( nv, newdl, BDY((DP) BDY(p))->dl ) > 0 ) break;
-         if ( p ) NEXT(NEXT(last) = newnd) = p;
-         else NEXT(last) = newnd;
-         return nd;
  }
- NODE NODE_sortb( node, dec )
+ void printdl(DL dl)
- NODE node;
- int dec;
  {
-         register NODE nd, ans;
+   int i;
-         for ( ans = 0, nd = node; nd; nd = NEXT(nd) )
+   fprintf(asir_out,"<<");
-                 ans = NODE_sortb_insert( (DP) BDY(nd), ans, dec );
+   for ( i = 0; i < CNVars-1; i++ )
-         return ans;
+     fprintf(asir_out,"%d,",dl->d[i]);
+   fprintf(asir_out,"%d>>",dl->d[i]);
  }
- NODE /* of index */ NODE_sortbi_insert( newdpi, nd, dec )
+ void pltovl(LIST l,VL *vl)
- int newdpi;
- NODE /* of index */ nd;
- int dec;
  {
-         register NODE last, p;
+   NODE n;
-         register DL newdl = psh[newdpi];
+   VL r,r0;
-         register int (*cmpfun)() = cmpdl, nv = CNVars;
-         NODE newnd;
+   n = BDY(l);
-         int sgn = dec ? 1 : -1;
+   for ( r0 = 0; n; n = NEXT(n) ) {
-         MKNODE( newnd, newdpi, 0 );
+     NEXTVL(r0,r); r->v = VR((P)BDY(n));
-         if ( !(last = nd) || sgn*(*cmpfun)( nv, newdl, psh[(int)BDY(last)] ) > 0 ) {
+   }
-                 NEXT(newnd) = last;
+   if ( r0 ) NEXT(r) = 0;
-                 return newnd;
+   *vl = r0;
-         }
-         for ( ; p = NEXT(last); last = p )
-                 if ( sgn*(*cmpfun)( nv, newdl, psh[(int)BDY(p)] ) > 0 ) break;
-         if ( p ) NEXT(NEXT(last) = newnd) = p;
-         else NEXT(last) = newnd;
-         return nd;
  }
- NODE NODE_sortbi( node, dec )
+ void vltopl(VL vl,LIST *l)
- NODE node;
- int dec;
  {
-         register NODE nd, ans;
+   VL n;
+   NODE r,r0;
+   P p;
-         for ( ans = 0, nd = node; nd; nd = NEXT(nd) )
+   n = vl;
-                 ans = NODE_sortbi_insert( (int) BDY(nd), ans, dec );
+   for ( r0 = 0; n; n = NEXT(n) ) {
-         return ans;
+     NEXTNODE(r0,r); MKV(n->v,p); BDY(r) = (pointer)p;
+   }
+   if ( r0 ) NEXT(r) = 0;
+   MKLIST(*l,r0);
  }
- void reduceall(in,h)
+ void makesubst(VL v,NODE *s)
- NODE in;
- NODE *h;
  {
-         NODE r,t,top;
+   NODE r,r0;
-         int n,i,j;
+   Q q;
-         int *w;
+   unsigned int n;
-         DP g,g1;
-         struct oEGT tmp0,tmp1;
-         if ( NoRA ) {
+   for ( r0 = 0; v; v = NEXT(v) ) {
-                 *h = in; return;
+     NEXTNODE(r0,r); BDY(r) = (pointer)v->v;
-         }
+ #if defined(_PA_RISC1_1)
-         if ( Print || PrintShort ) {
+     n = mrand48()&BMASK; UTOQ(n,q);
-                 fprintf(asir_out,"reduceall\n"); fflush(asir_out);
-         }
-         r = NODE_sortbi(in,0);
-         n = length(r);
-         w = (int *)ALLOCA(n*sizeof(int));
-         for ( i = 0, t = r; i < n; i++, t = NEXT(t) )
-                 w[i] = (int)BDY(t);
-         for ( i = 0; i < n; i++ ) {
-                 for ( top = 0, j = n-1; j >= 0; j-- )
-                         if ( j != i ) {
-                                 MKNODE(t,(pointer)w[j],top); top = t;
-                         }
-                 get_eg(&tmp0);
-                 dp_load(w[i],&ps[w[i]]);
-                 if ( GenTrace ) {
-                         Q q;
-                         NODE node;
-                         LIST hist;
-                         STOQ(w[i],q);
-                         node = mknode(4,ONE,q,ONE,ONE);
-                         MKLIST(hist,node);
-                         MKNODE(TraceList,hist,0);
-                 }
-                 if ( !PtozpRA || !Multiple )
-                         _dp_nf(top,ps[w[i]],ps,1,&g);
-                 else
- #if MPI
-                         _dp_nf_ptozp_mpi(top,ps[w[i]],ps,1,Multiple,&g);
  #else
-                         _dp_nf_ptozp(top,ps[w[i]],ps,1,Multiple,&g);
+     n = random(); UTOQ(n,q);
  #endif
-                 prim_part(g,0,&g1);
+     NEXTNODE(r0,r); BDY(r) = (pointer)q;
-                 get_eg(&tmp1); add_eg(&eg_ra,&tmp0,&tmp1);
+   }
-                 if ( Print || PrintShort ) {
+   if ( r0 ) NEXT(r) = 0;
-                         fprintf(asir_out,"."); fflush(asir_out);
+   *s = r0;
-                 }
-                 w[i] = newps(g1,0,(NODE)0);
-         }
-         for ( top = 0, j = n-1; j >= 0; j-- ) {
-                 MKNODE(t,(pointer)w[j],top); top = t;
-         }
-         *h = top;
-         if ( Print || PrintShort )
-                 fprintf(asir_out,"\n");
  }
- void reduceall_mod(in,m,h)
+ void printsubst(NODE s)
- NODE in;
- int m;
- NODE *h;
  {
-         NODE r,t,top;
+   fputc('[',asir_out);
-         int n,i,j;
+   while ( s ) {
-         int *w;
+     printv(CO,(V)BDY(s)); s = NEXT(s);
-         DP g;
+     fprintf(asir_out,"->%d",QTOS((Q)BDY(s)));
-         struct oEGT tmp0,tmp1;
+     if ( NEXT(s) ) {
+       fputc(',',asir_out); s = NEXT(s);
-         if ( NoRA ) {
+     } else
-                 *h = in; return;
+       break;
-         }
+   }
-         if ( Print || PrintShort ) {
+   fprintf(asir_out,"]\n"); return;
-                 fprintf(asir_out,"reduceall\n"); fflush(asir_out);
-         }
-         r = NODE_sortbi(in,0);
-         n = length(r);
-         w = (int *)ALLOCA(n*sizeof(int));
-         for ( i = 0, t = r; i < n; i++, t = NEXT(t) )
-                 w[i] = (int)BDY(t);
-         for ( i = 0; i < n; i++ ) {
-                 for ( top = 0, j = n-1; j >= 0; j-- )
-                         if ( j != i ) {
-                                 MKNODE(t,(pointer)w[j],top); top = t;
-                         }
-                 get_eg(&tmp0);
-                 if ( PCoeffs )
-                         dp_nf_mod(top,ps[w[i]],ps,m,1,&g);
-                 else
-                         _dp_nf_mod(top,ps[w[i]],ps,m,1,&g);
-                 get_eg(&tmp1); add_eg(&eg_ra,&tmp0,&tmp1);
-                 if ( Print || PrintShort ) {
-                         fprintf(asir_out,"."); fflush(asir_out);
-                 }
-                 w[i] = newps_mod(g,m);
-         }
-         for ( top = 0, j = n-1; j >= 0; j-- ) {
-                 MKNODE(t,(pointer)w[j],top); top = t;
-         }
-         *h = top;
-         if ( Print || PrintShort )
-                 fprintf(asir_out,"\n");
  }
- int newps(a,m,subst)
+ void vlminus(VL v,VL w,VL *d)
- DP a;
- int m;
- NODE subst;
  {
-         if ( m && !validhc(!a?0:BDY(a)->c,m,subst) )
+   int i,j,n,m;
-                 return -1;
+   V *va,*wa;
-         if ( psn == pslen ) {
+   V a;
-                 pslen *= 2;
+   VL r,r0;
-                 ps = (DP *)REALLOC((char *)ps,pslen*sizeof(DP));
+   VL t;
-                 psh = (DL *)REALLOC((char *)psh,pslen*sizeof(DL));
-                 pss = (int *)REALLOC((char *)pss,pslen*sizeof(int));
-                 psc = (P *)REALLOC((char *)psc,pslen*sizeof(P));
-                 if ( m )
-                         psm = (DP *)REALLOC((char *)psm,pslen*sizeof(DP));
-         }
-         if ( Demand ) {
-                 if ( doing_f4 )
-                         ps[psn] = a;
-                 else
-                         ps[psn] = 0;
-                 dp_save(psn,(Obj)a,0);
-         } else
-                 ps[psn] = a;
-         psh[psn] = BDY(a)->dl;
-         pss[psn] = a->sugar;
-         psc[psn] = BDY(a)->c;
-         if ( m )
-                 _dp_mod(a,m,subst,&psm[psn]);
-         if ( GenTrace ) {
-                 NODE tn,tr,tr1;
-                 LIST trace;
-                 /* reverse the TraceList */
-                 tn = TraceList;
-                 for ( tr = 0; tn; tn = NEXT(tn) ) {
-                         MKNODE(tr1,BDY(tn),tr); tr = tr1;
-                 }
-                 MKLIST(trace,tr);
-                 if ( OXCheck >= 0 ) {
-                         NODE arg;
-                         Q q1,q2;
-                         STRING fname;
-                         Obj dmy;
-                         STOQ(OXCheck,q1);
+   for ( n = 0, t = v; t; t = NEXT(t), n++ );
-                         MKSTR(fname,"check_trace");
+   va = (V *)ALLOCA(n*sizeof(V));
-                         STOQ(psn,q2);
+   for ( i = 0, t = v; t; t = NEXT(t), i++ )
-                         arg = mknode(5,q1,fname,a,q2,trace);
+     va[i] = t->v;
-                         Pox_cmo_rpc(arg,&dmy);
+   for ( m = 0, t = w; t; t = NEXT(t), m++ );
-                 } else
+   wa = (V *)ALLOCA(m*sizeof(V));
-                         dp_save(psn,(Obj)trace,"t");
+   for ( i = 0, t = w; t; t = NEXT(t), i++ )
-                 TraceList = 0;
+     wa[i] = t->v;
-         }
+   for ( i = 0; i < n; i++ ) {
-         return psn++;
+     a = va[i];
+     for ( j = 0; j < m; j++ )
+       if ( a == wa[j] )
+         break;
+     if ( j < m )
+       va[i] = 0;
+   }
+   for ( r0 = 0, i = 0; i < n; i++ )
+     if ( va[i] ) { NEXTVL(r0,r); r->v = va[i];  }
+   if ( r0 ) NEXT(r) = 0;
+   *d = r0;
  }
- int newps_nosave(a,m,subst)
+ int validhc(P a,int m,NODE s)
- DP a;
- int m;
- NODE subst;
  {
-         if ( m && !validhc(!a?0:BDY(a)->c,m,subst) )
+   P c,c1;
-                 return -1;
+   V v;
-         if ( psn == pslen ) {
-                 pslen *= 2;
-                 ps = (DP *)REALLOC((char *)ps,pslen*sizeof(DP));
-                 psh = (DL *)REALLOC((char *)psh,pslen*sizeof(DL));
-                 pss = (int *)REALLOC((char *)pss,pslen*sizeof(int));
-                 psc = (P *)REALLOC((char *)psc,pslen*sizeof(P));
-                 if ( m )
-                         psm = (DP *)REALLOC((char *)psm,pslen*sizeof(DP));
-         }
-         ps[psn] = 0;
-         psh[psn] = BDY(a)->dl;
-         pss[psn] = a->sugar;
-         psc[psn] = BDY(a)->c;
-         if ( m )
-                 _dp_mod(a,m,subst,&psm[psn]);
-         return psn++;
- }
- int newps_mod(a,m)
+   if ( !a )
- DP a;
+     return 0;
- int m;
+   for ( c = a; s; s = NEXT(s) ) {
- {
+     v = (V)BDY(s); s = NEXT(s);
-         if ( psn == pslen ) {
+     substp(CO,c,v,(P)BDY(s),&c1); c = c1;
-                 pslen *= 2;
+   }
-                 ps = (DP *)REALLOC((char *)ps,pslen*sizeof(DP));
+   ptomp(m,c,&c1);
-                 psh = (DL *)REALLOC((char *)psh,pslen*sizeof(DL));
+   return c1 ? 1 : 0;
-                 pss = (int *)REALLOC((char *)pss,pslen*sizeof(int));
-                 psc = (P *)REALLOC((char *)psc,pslen*sizeof(P)); /* XXX */
-         }
-         ps[psn] = a;
-         psh[psn] = BDY(ps[psn])->dl;
-         pss[psn] = ps[psn]->sugar;
-         return psn++;
  }
- void reducebase_dehomo(f,g)
+ void setup_arrays(NODE f,int m,NODE *r)
- NODE f,*g;
  {
-         int n,i,j,k;
+   int i;
-         int *r;
+   NODE s,s0,f0;
-         DL *w,d;
-         DP u;
-         NODE t,top;
-         n = length(f);
+ #if 1
-         w = (DL *)ALLOCA(n*sizeof(DL));
+   f0 = f = NODE_sortb(f,1);
-         r = (int *)ALLOCA(n*sizeof(int));
+ #else
-         for ( i = 0, t = f; i < n; i++, t = NEXT(t) ) {
+   f0 = f;
-                 r[i] = (int)BDY(t); w[i] = psh[r[i]];
+ #endif
-         }
+   psn = length(f); pslen = 2*psn;
-         for ( i = 0; i < n; i++ ) {
+   ps = (DP *)MALLOC(pslen*sizeof(DP));
-                 for ( j = 0, d = w[i]; j < n; j++ ) {
+   psh = (DL *)MALLOC(pslen*sizeof(DL));
-                         if ( j != i ) {
+   pss = (int *)MALLOC(pslen*sizeof(int));
-                                 for ( k = 0; k < NVars; k++ )
+   psc = (P *)MALLOC(pslen*sizeof(P));
-                                         if ( d->d[k] < w[j]->d[k] )
+   for ( i = 0; i < psn; i++, f = NEXT(f) ) {
-                                                 break;
+     prim_part((DP)BDY(f),m,&ps[i]);
-                                 if ( k == NVars )
+     if ( Demand )
-                                         break;
+       dp_save(i,(Obj)ps[i],0);
-                         }
+     psh[i] = BDY(ps[i])->dl;
-                 }
+     pss[i] = ps[i]->sugar;
-                 if ( j != n )
+     psc[i] = (P)BDY(ps[i])->c;
-                         r[i] = -1;
+   }
-         }
+   if ( GenTrace ) {
-         for ( top = 0, i = n-1; i >= 0; i-- )
+     Q q;
-                 if ( r[i] >= 0 ) {
+     STRING fname;
-                         dp_load(r[i],&ps[r[i]]); dp_dehomo(ps[r[i]],&u);
+     LIST input;
-                         if ( GenTrace ) {
+     NODE arg,t,t1;
-                                 Q q;
+     Obj obj;
-                                 LIST hist;
-                                 NODE node;
+     t = 0;
+     for ( i = psn-1; i >= 0; i-- ) {
+       MKNODE(t1,ps[i],t);
+       t = t1;
+     }
+     MKLIST(input,t);
-                                 STOQ(r[i],q);
+     if ( OXCheck >= 0 ) {
-                                 node = mknode(4,0,q,0,0);
+       STOQ(OXCheck,q);
-                                 MKLIST(hist,node);
+       MKSTR(fname,"register_input");
-                                 MKNODE(TraceList,hist,0);
+       arg = mknode(3,q,fname,input);
-                         }
+       Pox_cmo_rpc(arg,&obj);
-                         j = newps(u,0,0);
+     } else if ( OXCheck < 0 ) {
-                         MKNODE(t,j,top); top = t;
+       MKNODE(AllTraceList,input,0);
-                 }
+     }
-         *g = top;
+   }
+   for ( s0 = 0, i = 0; i < psn; i++ ) {
+     NEXTNODE(s0,s); BDY(s) = (pointer)i;
+   }
+   if ( s0 ) NEXT(s) = 0;
+   *r = s0;
  }
- NODE append_one(f,n)
+ void prim_part(DP f,int m,DP *r)
- NODE f;
- int n;
  {
-         NODE t;
+   P d,t;
-         if ( Reverse || !f ) {
+   if ( m > 0 ) {
-                 MKNODE(t,(pointer)n,f); return t;
+     if ( PCoeffs )
-         } else {
+       dp_prim_mod(f,m,r);
-                 for ( t = f; NEXT(t); t = NEXT(t) );
+     else
-                 MKNODE(NEXT(t),(pointer)n,0);
+       _dp_monic(f,m,r);
-                 return f;
+   } else {
-         }
+     if ( dp_fcoeffs || PCoeffs )
+       dp_prim(f,r);
+     else
+       dp_ptozp(f,r);
+     if ( GenTrace && TraceList ) {
+       /* adust the denominator according to the final
+          content reduction */
+       divsp(CO,(P)BDY(f)->c,(P)BDY(*r)->c,&d);
+       mulp(CO,(P)ARG3(BDY((LIST)BDY(TraceList))),d,&t);
+       ARG3(BDY((LIST)BDY(TraceList))) = t;
+     }
+   }
  }
- DP_pairs minp( d, prest )
+ NODE /* of DP */ NODE_sortb_insert( DP newdp, NODE /* of DP */ nd, int dec )
- DP_pairs d, *prest;
  {
-         register DP_pairs m, ml, p, l;
+   register NODE last, p;
-         register DL lcm;
+   register DL newdl = BDY(newdp)->dl;
-         register int s, nv = CNVars;
+   register int (*cmpfun)() = cmpdl, nv = CNVars;
-         register int (*cmpfun)() = cmpdl;
+   NODE newnd;
+   int sgn = dec ? 1 : -1;
-         if ( !(p = NEXT(m = d)) ) {
+   MKNODE( newnd, newdp, 0 );
-                 *prest = p;
+   if ( !(last = nd) || sgn*(*cmpfun)( nv, newdl, BDY((DP) BDY(last))->dl ) > 0 ) {
-                 NEXT(m) = 0;
+     NEXT(newnd) = last;
-                 return m;
+     return newnd;
-         }
+   }
-         for ( lcm = m->lcm, s = m->sugar, ml = 0, l = m; p; p = NEXT(l = p) )
+   for ( ; p = NEXT(last); last = p )
-                 if ( NoSugar ? (*cmpfun)( nv, lcm, p->lcm ) >= 0 :
+     if ( sgn*(*cmpfun)( nv, newdl, BDY((DP) BDY(p))->dl ) > 0 ) break;
-                      (s > p->sugar || s == p->sugar && (*cmpfun)( nv, lcm, p->lcm ) >= 0) )
+   if ( p ) NEXT(NEXT(last) = newnd) = p;
-                         ml = l,  lcm = (m = p)->lcm,  s = p->sugar;
+   else NEXT(last) = newnd;
-         if ( !ml ) *prest = NEXT(m);
+   return nd;
-         else {
-                 NEXT(ml) = NEXT(m);
-                 *prest = d;
-         }
-         NEXT(m) = 0;
-         return m;
  }
- void minsugar(d,dm,dr)
+ NODE NODE_sortb( NODE node, int dec )
- DP_pairs d;
- DP_pairs *dm,*dr;
  {
-         int msugar;
+   register NODE nd, ans;
-         DP_pairs t,dm0,dr0,dmt,drt;
-         for ( msugar = d->sugar, t = NEXT(d); t; t = NEXT(t) )
+   for ( ans = 0, nd = node; nd; nd = NEXT(nd) )
-                 if ( t->sugar < msugar )
+     ans = NODE_sortb_insert( (DP) BDY(nd), ans, dec );
-                         msugar = t->sugar;
+   return ans;
-         dm0 = 0; dr0 = 0;
-         for ( t = d; t; t = NEXT(t) ) {
-                 if ( t->sugar == msugar ) {
-                         NEXTDPP(dm0,dmt);
-                         dmt->dp1 = t->dp1; dmt->dp2 = t->dp2;
-                         dmt->lcm = t->lcm; dmt->sugar = t->sugar;
-                 } else {
-                         NEXTDPP(dr0,drt);
-                         drt->dp1 = t->dp1; drt->dp2 = t->dp2;
-                         drt->lcm = t->lcm; drt->sugar = t->sugar;
-                 }
-         }
-         if ( dm0 ) NEXT(dmt) = 0;
-         if ( dr0 ) NEXT(drt) = 0;
-         *dm = dm0; *dr = dr0;
  }
- NODE gb(f,m,subst)
+ NODE /* of index */ NODE_sortbi_insert( int newdpi, NODE /* of index */ nd, int dec )
- NODE f;
- int m;
- NODE subst;
  {
-         int i,nh,prev,mag;
+   register NODE last, p;
-         NODE r,g,gall;
+   register DL newdl = psh[newdpi];
-         DP_pairs d,d1;
+   register int (*cmpfun)() = cmpdl, nv = CNVars;
-         DP_pairs l;
+   NODE newnd;
-         DP h,nf,nfm,dp1,dp2;
+   int sgn = dec ? 1 : -1;
-         MP mp;
+   MKNODE( newnd, newdpi, 0 );
-         struct oEGT tnf0,tnf1,tnfm0,tnfm1,tpz0,tpz1,tsp0,tsp1,tspm0,tspm1,tnp0,tnp1,tmp0,tmp1;
+   if ( !(last = nd) || sgn*(*cmpfun)( nv, newdl, psh[(int)BDY(last)] ) > 0 ) {
-         int skip_nf_flag;
+     NEXT(newnd) = last;
-         double t_0;
+     return newnd;
-         Q q;
+   }
-         int new_sugar;
+   for ( ; p = NEXT(last); last = p )
-         static prev_sugar = -1;
+     if ( sgn*(*cmpfun)( nv, newdl, psh[(int)BDY(p)] ) > 0 ) break;
+   if ( p ) NEXT(NEXT(last) = newnd) = p;
-         Max_mag = 0;
+   else NEXT(last) = newnd;
-         prev = 1;
+   return nd;
-         doing_f4 = 0;
-         if ( m ) {
-                 psm = (DP *)MALLOC(pslen*sizeof(DP));
-                 for ( i = 0; i < psn; i++ )
-                         if ( psh[i] && !validhc(psc[i],m,subst) )
-                                 return 0;
-                         else
-                                 _dp_mod(ps[i],m,subst,&psm[i]);
-         }
-         for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
-                 i = (int)BDY(r);
-                 d = updpairs(d,g,i);
-                 g = updbase(g,i);
-                 gall = append_one(gall,i);
-         }
-         while ( d ) {
-                 get_eg(&tmp0);
-                 l = minp(d,&d1); d = d1;
-                 get_eg(&tmp1); add_eg(&eg_mp,&tmp0,&tmp1);
-                 if ( m ) {
-                         get_eg(&tspm0);
-                         _dp_sp_mod_dup(psm[l->dp1],psm[l->dp2],m,&h);
-                         new_sugar = h->sugar;
-                         get_eg(&tspm1); add_eg(&eg_spm,&tspm0,&tspm1);
-                         get_eg(&tnfm0);
-                         _dp_nf_mod_destructive(gall,h,psm,m,0,&nfm);
-                         get_eg(&tnfm1); add_eg(&eg_nfm,&tnfm0,&tnfm1);
-                 } else
-                         nfm = (DP)1;
-                 if ( nfm ) {
-                         get_eg(&tsp0);
-                         if ( Demand ) {
-                                 if ( dp_load_t(psn,&nf) ) {
-                                         skip_nf_flag = 1;
-                                         get_eg(&tsp1); add_eg(&eg_nf,&tsp0,&tsp1);
-                                         tnf0=tsp0; tnf1=tsp1;
-                                         goto skip_nf;
-                                 } else {
-                                         skip_nf_flag = 0;
-                                         dp_load(l->dp1,&dp1); dp_load(l->dp2,&dp2);
-                                         dp_sp(dp1,dp2,&h);
-                                 }
-                         } else
-                                 dp_sp(ps[l->dp1],ps[l->dp2],&h);
-                         if ( GenTrace ) {
-                                 STOQ(l->dp1,q); ARG1(BDY((LIST)BDY(NEXT(TraceList)))) = q;
-                                 STOQ(l->dp2,q); ARG1(BDY((LIST)BDY(TraceList))) = q;
-                         }
-                         new_sugar = h->sugar;
-                         get_eg(&tsp1); add_eg(&eg_sp,&tsp0,&tsp1);
-                         get_eg(&tnf0);
-                         t_0 = get_rtime();
-                         if ( !Multiple )
-                                 _dp_nf(gall,h,ps,!Top,&nf);
-                         else
- #if MPI
-                                 _dp_nf_ptozp_mpi(gall,h,ps,!Top,Multiple,&nf);
- #else
-                                 _dp_nf_ptozp(gall,h,ps,!Top,Multiple,&nf);
- #endif
-                         if ( Print )
-                                 fprintf(asir_out,"(%.3g)",get_rtime()-t_0);
-                         get_eg(&tnf1); add_eg(&eg_nf,&tnf0,&tnf1);
-                 } else
-                         nf = 0;
- skip_nf:
-                 if ( nf ) {
-                         NZR++;
-                         get_eg(&tpz0);
-                         prim_part(nf,0,&h);
-                         get_eg(&tpz1); add_eg(&eg_pz,&tpz0,&tpz1);
-                         get_eg(&tnp0);
-                         if ( Demand && skip_nf_flag )
-                                 nh = newps_nosave(h,m,subst);
-                         else
-                                 nh = newps(h,m,subst);
-                         get_eg(&tnp1); add_eg(&eg_np,&tnp0,&tnp1);
-                         if ( nh < 0 )
-                                 return 0;
-                         d = updpairs(d,g,nh);
-                         g = updbase(g,nh);
-                         gall = append_one(gall,nh);
-                         if ( !dp_fcoeffs && ShowMag ) {
-                                 for ( mag = 0, mp = BDY(h); mp; mp = NEXT(mp) )
-                                         mag += p_mag((P)mp->c);
-                                 Max_mag = MAX(Max_mag,mag);
-                         }
-                         if ( Print ) {
-                                 if ( !prev )
-                                         fprintf(asir_out,"\n");
-                                 print_split_e(&tnf0,&tnf1); print_split_e(&tpz0,&tpz1);
-                                 printdl(psh[nh]);
-                                 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]);
-                                 if ( ShowMag )
-                                         fprintf(asir_out,",mag=%d",mag);
-                                 fprintf(asir_out,"\n"); fflush(asir_out);
-                         } else if ( PrintShort ) {
-                                 fprintf(asir_out,"+"); fflush(asir_out);
-                         }
-                         prev = 1;
-                 } else {
-                         if ( m )
-                                 add_eg(&eg_znfm,&tnfm0,&tnfm1);
-                         ZR++;
-                         if ( Print || PrintShort ) {
-                                 if ( new_sugar != prev_sugar ) {
-                                         fprintf(asir_out,"[%d]",new_sugar);
-                                         prev_sugar = new_sugar;
-                                 }
-                                 fprintf(asir_out,"."); fflush(asir_out); prev = 0;
-                         }
-                 }
-         }
-         if ( Print || PrintShort )
-                 fprintf(asir_out,"gb done\n");
-         return g;
  }
- NODE gbd(f,m,subst,dlist)
+ NODE NODE_sortbi( NODE node, int dec )
- NODE f;
- int m;
- NODE subst;
- NODE dlist;
  {
-         int i,nh,prev;
+   register NODE nd, ans;
-         NODE r,g,gall;
-         struct dp_pairs ol;
-         DP_pairs l;
-         NODE pair;
-         DP h,nf,nfm,dp1,dp2;
-         struct oEGT tnf0,tnf1,tnfm0,tnfm1,tpz0,tpz1,tsp0,tsp1,tspm0,tspm1,tnp0,tnp1;
-         prev = 1;
+   for ( ans = 0, nd = node; nd; nd = NEXT(nd) )
-         l = &ol;
+     ans = NODE_sortbi_insert( (int) BDY(nd), ans, dec );
-         if ( m ) {
+   return ans;
-                 psm = (DP *)MALLOC(pslen*sizeof(DP));
-                 for ( i = 0; i < psn; i++ )
-                         if ( psh[i] && !validhc(psc[i],m,subst) )
-                                 return 0;
-                         else
-                                 _dp_mod(ps[i],m,subst,&psm[i]);
-         }
-         for ( gall = g = 0, r = f; r; r = NEXT(r) ) {
-                 i = (int)BDY(r);
-                 g = updbase(g,i);
-                 gall = append_one(gall,i);
-         }
-         while ( dlist ) {
-                 pair = BDY((LIST)BDY(dlist)); dlist = NEXT(dlist);
-                 l->dp1 = QTOS((Q)BDY(pair)); pair = NEXT(pair);
-                 l->dp2 = QTOS((Q)BDY(pair));
-                 if ( m ) {
-                         get_eg(&tspm0);
-                         _dp_sp_mod_dup(ps[l->dp1],ps[l->dp2],m,&h);
-                         get_eg(&tspm1); add_eg(&eg_spm,&tspm0,&tspm1);
-                         get_eg(&tnfm0);
-                         _dp_nf_mod_destructive(gall,h,ps,m,!Top,&nf);
-                         get_eg(&tnfm1); add_eg(&eg_nfm,&tnfm0,&tnfm1);
-                 } else
-                         nfm = (DP)1;
-                 if ( nfm ) {
-                         get_eg(&tsp0);
-                         if ( Demand ) {
-                                 dp_load(l->dp1,&dp1); dp_load(l->dp2,&dp2);
-                                 dp_sp(dp1,dp2,&h);
-                         } else
-                                 dp_sp(ps[l->dp1],ps[l->dp2],&h);
-                         get_eg(&tsp1); add_eg(&eg_sp,&tsp0,&tsp1);
-                         get_eg(&tnfm0);
-                         get_eg(&tnf0);
-                         if ( !Multiple )
-                                 _dp_nf(gall,h,ps,!Top,&nf);
-                         else
-                                 _dp_nf_ptozp(gall,h,ps,!Top,Multiple,&nf);
-                         get_eg(&tnf1); add_eg(&eg_nf,&tnf0,&tnf1);
-                 } else
-                         nf = 0;
-                 if ( nf ) {
-                         NZR++;
-                         get_eg(&tpz0);
-                         prim_part(nf,0,&h);
-                         get_eg(&tpz1); add_eg(&eg_pz,&tpz0,&tpz1);
-                         get_eg(&tnp0);
-                         nh = newps(h,m,subst);
-                         get_eg(&tnp1); add_eg(&eg_np,&tnp0,&tnp1);
-                         if ( nh < 0 )
-                                 return 0;
-                         g = updbase(g,nh);
-                         gall = append_one(gall,nh);
-                         if ( Print ) {
-                                 if ( !prev )
-                                         fprintf(asir_out,"\n");
-                                 print_split_eg(&tnf0,&tnf1); fflush(asir_out);
-                                 fprintf(asir_out,"(%d,%d),nb=%d,nab=%d,rp=%d,sugar=%d",l->dp1,l->dp2,length(g),length(gall),length(dlist),pss[nh]);
-                                 printdl(psh[nh]); fprintf(asir_out,"\n"); fflush(asir_out);
-                         }
-                         prev = 1;
-                 } else {
-                         if ( m )
-                                 add_eg(&eg_znfm,&tnfm0,&tnfm1);
-                         ZR++;
-                         if ( Print ) {
-                                 fprintf(asir_out,"."); fflush(asir_out); prev = 0;
-                         }
-                 }
-         }
-         if ( Print )
-                 fprintf(asir_out,"gb done\n");
-         return g;
  }
- NODE gb_mod(f,m)
+ void reduceall(NODE in,NODE *h)
- NODE f;
- int m;
  {
-         int i,nh,prev;
+   NODE r,t,top;
-         NODE r,g,gall;
+   int n,i,j;
-         DP_pairs d,d1;
+   int *w;
-         DP_pairs l;
+   DP g,g1;
-         DP h,nf;
+   struct oEGT tmp0,tmp1;
-         struct oEGT tnfm0,tnfm1,tspm0,tspm1,tmp0,tmp1,tpz0,tpz1;
-         prev = 1;
+   if ( NoRA ) {
-         for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
+     *h = in; return;
-                 i = (int)BDY(r);
+   }
-                 d = updpairs(d,g,i);
+   if ( DP_Print || DP_PrintShort ) {
-                 g = updbase(g,i);
+     fprintf(asir_out,"reduceall\n"); fflush(asir_out);
-                 gall = append_one(gall,i);
+   }
-         }
+   r = NODE_sortbi(in,0);
-         while ( d ) {
+   n = length(r);
-                 get_eg(&tmp0);
+   w = (int *)ALLOCA(n*sizeof(int));
-                 l = minp(d,&d1); d = d1;
+   for ( i = 0, t = r; i < n; i++, t = NEXT(t) )
-                 get_eg(&tmp1); add_eg(&eg_mp,&tmp0,&tmp1); get_eg(&tspm0);
+     w[i] = (int)BDY(t);
-                 if ( PCoeffs ) {
+   /* w[i] < 0 : reduced to 0 */
-                         dp_sp_mod(ps[l->dp1],ps[l->dp2],m,&h);
+   for ( i = 0; i < n; i++ ) {
-                         get_eg(&tspm1); add_eg(&eg_spm,&tspm0,&tspm1); get_eg(&tnfm0);
+     for ( top = 0, j = n-1; j >= 0; j-- )
-                         dp_nf_mod(gall,h,ps,m,!Top,&nf);
+       if ( w[j] >= 0 && j != i ) {
-                 } else {
+         MKNODE(t,(pointer)w[j],top); top = t;
-                         _dp_sp_mod_dup(ps[l->dp1],ps[l->dp2],m,&h);
+       }
-                         get_eg(&tspm1); add_eg(&eg_spm,&tspm0,&tspm1); get_eg(&tnfm0);
+     get_eg(&tmp0);
-                         _dp_nf_mod_destructive(gall,h,ps,m,!Top,&nf);
+     dp_load(w[i],&ps[w[i]]);
-                 }
-                 get_eg(&tnfm1); add_eg(&eg_nfm,&tnfm0,&tnfm1);
+     if ( GenTrace ) {
-                 if ( nf ) {
+       Q q;
-                         NZR++;
+       NODE node;
-                         get_eg(&tpz0);
+       LIST hist;
-                         prim_part(nf,m,&h);
-                         get_eg(&tpz1); add_eg(&eg_pz,&tpz0,&tpz1);
+       STOQ(w[i],q);
-                         nh = newps_mod(h,m);
+       node = mknode(4,ONE,q,ONE,ONE);
-                         if ( nh < 0 )
+       MKLIST(hist,node);
-                                 return 0;
+       MKNODE(TraceList,hist,0);
-                         d = updpairs(d,g,nh);
+     }
-                         g = updbase(g,nh);
+     _dp_nf(top,ps[w[i]],ps,1,&g);
-                         if ( InterReduce )
+     prim_part(g,0,&g1);
-                                 interreduce_mod(g,nh,m);
+     get_eg(&tmp1); add_eg(&eg_ra,&tmp0,&tmp1);
-                         gall = append_one(gall,nh);
+     if ( DP_Print || DP_PrintShort ) {
-                         if ( Print ) {
+       fprintf(asir_out,"."); fflush(asir_out);
-                                 if ( !prev )
+     }
-                                         fprintf(asir_out,"\n");
+     if ( g1 ) {
-                                 print_split_eg(&tnfm0,&tnfm1); fflush(asir_out);
+       w[i] = newps(g1,0,(NODE)0);
-                                 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]);
+     } else {
-                                 printdl(psh[nh]); fprintf(asir_out,"\n"); fflush(asir_out);
+       w[i] = -1;
-                         } else if ( PrintShort ) {
+     }
-                                 fprintf(asir_out,"+"); fflush(asir_out);
+   }
-                         }
+   for ( top = 0, j = n-1; j >= 0; j-- ) {
-                         prev = 1;
+     if ( w[j] >= 0 ) {
-                 } else {
+       MKNODE(t,(pointer)w[j],top); top = t;
-                         add_eg(&eg_znfm,&tnfm0,&tnfm1);
+     }
-                         ZR++;
+   }
-                         if ( Print || PrintShort ) {
+   *h = top;
-                                 fprintf(asir_out,"."); fflush(asir_out); prev = 0;
+   if ( DP_Print || DP_PrintShort )
-                         }
+     fprintf(asir_out,"\n");
-                 }
-         }
-         if ( Print || PrintShort )
-                 fprintf(asir_out,"gb_mod done\n");
-         return g;
  }
- void interreduce_mod(g,n,m)
+ void reduceall_mod(NODE in,int m,NODE *h)
- NODE g;
- int n,m;
  {
-         DP nf;
+   NODE r,t,top;
-         NODE gn,t;
+   int n,i,j;
-         int i;
+   int *w;
+   DP g,p;
+   struct oEGT tmp0,tmp1;
-         MKNODE(gn,(pointer)n,0);
+   if ( NoRA ) {
-         if ( PCoeffs )
+     *h = in; return;
-                 for ( t = g; t; t = NEXT(t) ) {
+   }
-                         i = (int)BDY(t);
+   if ( DP_Print || DP_PrintShort ) {
-                         if ( i != n ) {
+     fprintf(asir_out,"reduceall\n"); fflush(asir_out);
-                                 dp_nf_mod(gn,ps[i],ps,m,1,&nf); ps[i] = nf;
+   }
-                         }
+   r = NODE_sortbi(in,0);
-                 }
+   n = length(r);
-         else
+   w = (int *)ALLOCA(n*sizeof(int));
-                 for ( t = g; t; t = NEXT(t) ) {
+   for ( i = 0, t = r; i < n; i++, t = NEXT(t) )
-                         i = (int)BDY(t);
+     w[i] = (int)BDY(t);
-                         if ( i != n ) {
+   /* w[i] < 0 : reduced to 0 */
-                                 _dp_nf_mod(gn,ps[i],ps,m,1,&nf); ps[i] = nf;
+   for ( i = 0; i < n; i++ ) {
-                         }
+     for ( top = 0, j = n-1; j >= 0; j-- )
-                 }
+       if ( w[j] >= 0 && j != i ) {
+         MKNODE(t,(pointer)w[j],top); top = t;
+       }
+     get_eg(&tmp0);
+     if ( PCoeffs )
+       dp_nf_mod(top,ps[w[i]],ps,m,1,&g);
+     else {
+       dpto_dp(ps[w[i]],&p);
+       _dp_nf_mod_destructive(top,p,ps,m,1,&g);
+     }
+     get_eg(&tmp1); add_eg(&eg_ra,&tmp0,&tmp1);
+     if ( DP_Print || DP_PrintShort ) {
+       fprintf(asir_out,"."); fflush(asir_out);
+     }
+     if ( g ) {
+       w[i] = newps_mod(g,m);
+     } else {
+       w[i] = -1;
+     }
+   }
+   for ( top = 0, j = n-1; j >= 0; j-- ) {
+     if ( w[j] >= 0 ) {
+       MKNODE(t,(pointer)w[j],top); top = t;
+     }
+   }
+   *h = top;
+   if ( DP_Print || DP_PrintShort )
+     fprintf(asir_out,"\n");
  }
- void _dp_nf_mod(b,g,ps,mod,full,rp)
+ int newps(DP a,int m,NODE subst)
- NODE b;
- DP g;
- DP *ps;
- int mod,full;
- DP *rp;
  {
-         DP u,p,d,s,t;
+   if ( m && !validhc(!a?0:(P)BDY(a)->c,m,subst) )
-         NODE l;
+     return -1;
-         MP m,mr;
+   if ( psn == pslen ) {
-         int sugar,psugar;
+     pslen *= 2;
+     ps = (DP *)REALLOC((char *)ps,pslen*sizeof(DP));
-         if ( !g ) {
+     psh = (DL *)REALLOC((char *)psh,pslen*sizeof(DL));
-                 *rp = 0; return;
+     pss = (int *)REALLOC((char *)pss,pslen*sizeof(int));
-         }
+     psc = (P *)REALLOC((char *)psc,pslen*sizeof(P));
-         sugar = g->sugar;
+     if ( m )
-         for ( d = 0; g; ) {
+       psm = (DP *)REALLOC((char *)psm,pslen*sizeof(DP));
-                 for ( u = 0, l = b; l; l = NEXT(l) ) {
+   }
-                         if ( dp_redble(g,p = ps[(int)BDY(l)]) ) {
+   if ( Demand ) {
-                                 _dp_red_mod(g,p,mod,&u);
+     if ( doing_f4 )
-                                 psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar;
+       ps[psn] = a;
-                                 sugar = MAX(sugar,psugar);
+     else
-                                 if ( !u ) {
+       ps[psn] = 0;
-                                         if ( d )
+     dp_save(psn,(Obj)a,0);
-                                                 d->sugar = sugar;
+   } else
-                                         *rp = d; return;
+     ps[psn] = a;
-                                 }
+   psh[psn] = BDY(a)->dl;
-                                 break;
+   pss[psn] = a->sugar;
-                         }
+   psc[psn] = (P)BDY(a)->c;
-                 }
+   if ( m )
-                 if ( u )
+     _dp_mod(a,m,subst,&psm[psn]);
-                         g = u;
+   if ( GenTrace ) {
-                 else if ( !full ) {
+     NODE tn,tr,tr1;
-                         if ( g ) {
+     LIST trace,trace1;
-                                 MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t;
+     NODE arg;
-                         }
+     Q q1,q2;
-                         *rp = g; return;
+     STRING fname;
-                 } else {
+     Obj obj;
-                         m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c;
-                         NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td;
+     /* reverse the TraceList */
-                         _addmd(CO,mod,d,t,&s); d = s;
+     tn = TraceList;
-                         dp_rest(g,&t); g = t;
+     for ( tr = 0; tn; tn = NEXT(tn) ) {
-                 }
+       MKNODE(tr1,BDY(tn),tr); tr = tr1;
-         }
+     }
-         if ( d )
+     MKLIST(trace,tr);
-                 d->sugar = sugar;
+     if ( OXCheck >= 0 ) {
-         *rp = d;
+       STOQ(OXCheck,q1);
+       MKSTR(fname,"check_trace");
+       STOQ(psn,q2);
+       arg = mknode(5,q1,fname,a,q2,trace);
+       Pox_cmo_rpc(arg,&obj);
+     } else if ( OXCheck < 0 ) {
+       STOQ(psn,q1);
+       tn = mknode(2,q1,trace);
+       MKLIST(trace1,tn);
+       MKNODE(tr,trace1,AllTraceList);
+       AllTraceList = tr;
+     } else
+       dp_save(psn,(Obj)trace,"t");
+     TraceList = 0;
+   }
+   return psn++;
  }
- void _dp_nf(b,g,ps,full,rp)
+ int newps_nosave(DP a,int m,NODE subst)
- NODE b;
- DP g;
- DP *ps;
- int full;
- DP *rp;
  {
-         DP u,p,d,s,t,mult;
+   if ( m && !validhc(!a?0:(P)BDY(a)->c,m,subst) )
-         P coef;
+     return -1;
-         NODE l;
+   if ( psn == pslen ) {
-         MP m,mr;
+     pslen *= 2;
-         int sugar,psugar;
+     ps = (DP *)REALLOC((char *)ps,pslen*sizeof(DP));
+     psh = (DL *)REALLOC((char *)psh,pslen*sizeof(DL));
+     pss = (int *)REALLOC((char *)pss,pslen*sizeof(int));
+     psc = (P *)REALLOC((char *)psc,pslen*sizeof(P));
+     if ( m )
+       psm = (DP *)REALLOC((char *)psm,pslen*sizeof(DP));
+   }
+   ps[psn] = 0;
+   psh[psn] = BDY(a)->dl;
+   pss[psn] = a->sugar;
+   psc[psn] = (P)BDY(a)->c;
+   if ( m )
+     _dp_mod(a,m,subst,&psm[psn]);
+   return psn++;
+ }
-         if ( !g ) {
+ int newps_mod(DP a,int m)
-                 *rp = 0; return;
+ {
-         }
+   if ( psn == pslen ) {
-         sugar = g->sugar;
+     pslen *= 2;
-         for ( d = 0; g; ) {
+     ps = (DP *)REALLOC((char *)ps,pslen*sizeof(DP));
-                 for ( u = 0, l = b; l; l = NEXT(l) ) {
+     psh = (DL *)REALLOC((char *)psh,pslen*sizeof(DL));
-                         if ( dl_redble(BDY(g)->dl,psh[(int)BDY(l)]) ) {
+     pss = (int *)REALLOC((char *)pss,pslen*sizeof(int));
-                                 dp_load((int)BDY(l),&p);
+     psc = (P *)REALLOC((char *)psc,pslen*sizeof(P)); /* XXX */
-                                 /* t+u = coef*(d+g) - mult*p (t = coef*d) */
+   }
-                                 dp_red(d,g,p,&t,&u,&coef,&mult);
+   ps[psn] = a;
-                                 psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar;
+   psh[psn] = BDY(ps[psn])->dl;
-                                 sugar = MAX(sugar,psugar);
+   pss[psn] = ps[psn]->sugar;
-                                 if ( GenTrace ) {
+   return psn++;
-                                         LIST hist;
-                                         Q cq;
-                                         NODE node,node0;
-                                         STOQ((int)BDY(l),cq);
-                                         node0 = mknode(4,coef,cq,mult,ONE);
-                                         MKLIST(hist,node0);
-                                         MKNODE(node,hist,TraceList); TraceList = node;
-                                 }
-                                 if ( !u ) {
-                                         if ( d )
-                                                 d->sugar = sugar;
-                                         *rp = d; return;
-                                 }
-                                 d = t;
-                                 break;
-                         }
-                 }
-                 if ( u )
-                         g = u;
-                 else if ( !full ) {
-                         if ( g ) {
-                                 MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t;
-                         }
-                         *rp = g; return;
-                 } else {
-                         m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c;
-                         NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td;
-                         addd(CO,d,t,&s); d = s;
-                         dp_rest(g,&t); g = t;
-                 }
-         }
-         if ( d )
-                 d->sugar = sugar;
-         *rp = d;
  }
- #define SAFENM(q) ((q)?NM(q):0)
+ void reducebase_dehomo(NODE f,NODE *g)
+ {
+   int n,i,j,k;
+   int *r;
+   DL *w,d;
+   DP u;
+   NODE t,top;
- double pz_t_e, pz_t_d, pz_t_d1, pz_t_c, im_t_s, im_t_r;
+   n = length(f);
+   w = (DL *)ALLOCA(n*sizeof(DL));
+   r = (int *)ALLOCA(n*sizeof(int));
+   for ( i = 0, t = f; i < n; i++, t = NEXT(t) ) {
+     r[i] = (int)BDY(t); w[i] = psh[r[i]];
+   }
+   for ( i = 0; i < n; i++ ) {
+     for ( j = 0, d = w[i]; j < n; j++ ) {
+       if ( j != i ) {
+         for ( k = 0; k < NVars; k++ )
+           if ( d->d[k] < w[j]->d[k] )
+             break;
+         if ( k == NVars )
+           break;
+       }
+     }
+     if ( j != n )
+       r[i] = -1;
+   }
+   for ( top = 0, i = n-1; i >= 0; i-- )
+     if ( r[i] >= 0 ) {
+       dp_load(r[i],&ps[r[i]]); dp_dehomo(ps[r[i]],&u);
+       if ( GenTrace ) {
+         Q q;
+         LIST hist;
+         NODE node;
- extern int GenTrace;
+         STOQ(r[i],q);
- extern NODE TraceList;
+         node = mknode(4,NULLP,q,NULLP,NULLP);
+         MKLIST(hist,node);
+         MKNODE(TraceList,hist,0);
+       }
+       j = newps(u,0,0);
+       MKNODE(t,j,top); top = t;
+     }
+   *g = top;
+ }
- void _dp_nf_ptozp(b,g,ps,full,multiple,r)
+ NODE append_one(NODE f,int n)
- NODE b;
- DP g;
- DP *ps;
- int full,multiple;
- DP *r;
  {
-         DP u,dp,rp,t,t1,t2,red,shift;
+   NODE t;
-         Q dc,rc,dcq,rcq,cont,hr,hred,cr,cred,mcred,c,gcd,cq;
-         N gn,tn,cn;
-         NODE l;
-         MP m,mr;
-         int hmag,denom;
-         int sugar,psugar;
-         NODE dist;
-         STRING imul;
-         int ndist;
-         int kara_bit;
-         extern int kara_mag;
-         double get_rtime();
-         double t_0,t_00,tt,ttt,t_p,t_m,t_m1,t_m2,t_s,t_g,t_a;
-         LIST hist;
-         NODE node;
-         Q rcred,mrcred;
-         if ( !g ) {
+   if ( Reverse || !f ) {
-                 *r = 0; return;
+     MKNODE(t,(pointer)n,f); return t;
-         }
+   } else {
-         pz_t_e = pz_t_d = pz_t_d1 = pz_t_c = 0;
+     for ( t = f; NEXT(t); t = NEXT(t) );
-         t_p = t_m = t_m1 = t_m2 = t_s = t_g = t_a = 0;
+     MKNODE(NEXT(t),(pointer)n,0);
+     return f;
+   }
+ }
-         denom = Denominator?Denominator:1;
+ DP_pairs minp( DP_pairs d, DP_pairs *prest )
-         hmag = multiple*HMAG(g)/denom;
+ {
-         kara_bit = kara_mag*27; /* XXX */
+   register DP_pairs m, ml, p, l;
-         if ( Dist ) {
+   register DL lcm;
-                 dist = BDY(Dist);
+   register int s, nv = CNVars;
-                 ndist = length(dist);
+   register int (*cmpfun)() = cmpdl;
-         }
-         sugar = g->sugar;
-         dc = 0; dp = 0; rc = ONE; rp = g;
+   if ( !(p = NEXT(m = d)) ) {
-         MKSTR(imul,"dp_imul_index");
+     *prest = p;
+     NEXT(m) = 0;
-         /* g = dc*dp+rc*rp */
+     return m;
-         for ( ; rp; ) {
+   }
-                 for ( u = 0, l = b; l; l = NEXT(l) ) {
+   for ( lcm = m->lcm, s = m->sugar, ml = 0, l = m; p; p = NEXT(l = p) )
-                         if ( dl_redble(BDY(rp)->dl,psh[(int)BDY(l)]) ) {
+     if ( NoSugar ? (*cmpfun)( nv, lcm, p->lcm ) >= 0 :
-                                 t_0 = get_rtime();
+          (s > p->sugar || s == p->sugar && (*cmpfun)( nv, lcm, p->lcm ) >= 0) )
-                                 dp_load((int)BDY(l),&red);
+       ml = l,  lcm = (m = p)->lcm,  s = p->sugar;
-                                 hr = (Q)BDY(rp)->c; hred = (Q)BDY(red)->c;
+   if ( !ml ) *prest = NEXT(m);
-                                 gcdn(NM(hr),NM(hred),&gn);
+   else {
-                                 divsn(NM(hred),gn,&tn); NTOQ(tn,SGN(hred),cr);
+     NEXT(ml) = NEXT(m);
-                                 divsn(NM(hr),gn,&tn); NTOQ(tn,SGN(hr),cred);
+     *prest = d;
-                                 tt = get_rtime()-t_0; t_p += tt;
+   }
+   NEXT(m) = 0;
-                                 t_0 = get_rtime();
+   return m;
-                                 dp_subd(rp,red,&shift);
- #if INET
-                                 if ( Dist && ndist && HMAG(red) > kara_bit ) {
-                                         NODE n0,n1,n2,n3;
-                                         int i,s,id;
-                                         Obj dmy;
-                                         Q ind;
-                                         if ( Print )
-                                                 fprintf(asir_out,"d");
-                                         i = (int)BDY(l); STOQ(i,ind);
-                                         chsgnp((P)cred,(P *)&mcred);
-                                         MKNODE(n3,ind,0); MKNODE(n2,mcred,n3);
-                                         MKNODE(n1,imul,n2); MKNODE(n0,BDY(dist),n1);
-                                         Pox_rpc(n0,&dmy);
-                                         muldc(CO,rp,(P)cr,&t);
-                                         NEXT(n0)=0;
-                                         Pox_pop_local(n0,&t1);
-                                 } else
- #endif
-                                 {
- /*
-                                         if ( Print )
-                                                 fprintf(asir_out,"l");
- */
-                                         t_00 = get_rtime();
-                                         muldc(CO,rp,(P)cr,&t);
-                                         ttt = get_rtime()-t_00; t_m1 += ttt/dp_nt(rp);
-                                         t_00 = get_rtime();
-                                         chsgnp((P)cred,(P *)&mcred);
-                                         muldc(CO,red,(P)mcred,&t1);
-                                         ttt = get_rtime()-t_00; t_m2 += ttt/dp_nt(red);
-                                 }
-                                 t_00 = get_rtime();
-                                 muld(CO,shift,t1,&t2);
-                                 addd(CO,t,t2,&u);
-                                 tt = get_rtime(); t_m += tt-t_0;
-                                 ttt = get_rtime(); t_s += ttt-t_00;
-                                 psugar = (BDY(rp)->dl->td - BDY(red)->dl->td) + red->sugar;
-                                 sugar = MAX(sugar,psugar);
-                                 if ( GenTrace ) {
-                                         /* u = cr*rp + (-cred)*shift*red */
-                                         STOQ((int)BDY(l),cq);
-                                         node = mknode(4,cr,cq,0,0);
-                                         mulq(cred,rc,&rcred);
-                                         chsgnnum((Num)rcred,(Num *)&mrcred);
-                                         muldc(CO,shift,(P)mrcred,(DP *)&ARG2(node));
-                                         MKLIST(hist,node);
-                                 }
-                                 if ( !u ) {
-                                         if ( dp )
-                                                 dp->sugar = sugar;
-                                         *r = dp;
-                                         if ( GenTrace ) {
-                                                 ARG3(BDY(hist)) = ONE;
-                                                 MKNODE(node,hist,TraceList); TraceList = node;
-                                         }
-                                         goto final;
-                                 }
-                                 break;
-                         }
-                 }
-                 if ( u ) {
-                         if ( HMAG(u) > hmag ) {
-                                 t_0 = get_rtime();
- #if INET
-                                 if ( Dist && HMAG(u) > kara_bit ) {
-                                         if ( Print )
-                                                 fprintf(asir_out,"D");
-                                         dp_ptozp_d(dist,ndist,u,&t);
-                                 } else {
-                                         if ( Print )
-                                                 fprintf(asir_out,"L");
-                                         dp_ptozp_d(0,0,u,&t);
-                                 }
- #else
-                                 dp_ptozp(u,&t); /* XXX */
- #endif
-                                 tt = get_rtime()-t_0; t_g += tt;
-                                 t_0 = get_rtime();
-                                 divsn(NM((Q)BDY(u)->c),NM((Q)BDY(t)->c),&cn); NTOQ(cn,1,cont);
-                                 if ( !dp_fcoeffs && Print ) {
-                                         fprintf(asir_out,"(%d)",p_mag((P)cont)*100/p_mag((P)BDY(u)->c));
-                                         fflush(asir_out);
-                                 }
-                                 mulq(cr,dc,&dcq);
-                                 mulq(cont,rc,&rcq);
-                                 gcdn(SAFENM(dcq),SAFENM(rcq),&gn);
-                                 divsn(SAFENM(dcq),gn,&tn); NTOQ(tn,SGN(dcq),dc);
-                                 divsn(SAFENM(rcq),gn,&tn); NTOQ(tn,SGN(rcq),rc);
-                                 tt = get_rtime()-t_0; t_a += tt;
-                                 rp = t;
-                                 hmag = multiple*HMAG(rp)/denom;
-                                 if ( GenTrace ) {
-                                         NTOQ(gn,1,gcd);
-                                         ARG3(BDY(hist)) = (pointer)gcd;
-                                         MKNODE(node,hist,TraceList); TraceList = node;
-                                 }
-                         } else {
-                                 t_0 = get_rtime();
-                                 mulq(cr,dc,&dcq); dc = dcq;
-                                 tt = get_rtime()-t_0; t_a += tt;
-                                 rp = u;
-                                 if ( GenTrace ) {
-                                         ARG3(BDY(hist)) = (pointer)ONE;
-                                         MKNODE(node,hist,TraceList); TraceList = node;
-                                 }
-                         }
-                 } else if ( !full ) {
-                         if ( rp ) {
-                                 MKDP(rp->nv,BDY(rp),t); t->sugar = sugar; rp = t;
-                         }
-                         *r = rp;
-                         goto final;
-                 } else {
-                         t_0 = get_rtime();
-                         mulq((Q)BDY(rp)->c,rc,&c);
-                         gcdn(SAFENM(dc),SAFENM(c),&gn); NTOQ(gn,1,gcd);
-                         divsn(SAFENM(dc),gn,&tn); NTOQ(tn,SGN(dc),dcq);
-                         divsn(SAFENM(c),gn,&tn); NTOQ(tn,SGN(c),cq);
-                         muldc(CO,dp,(P)dcq,&t1);
-                         m = BDY(rp); NEWMP(mr); mr->dl = m->dl; mr->c = (P)cq;
-                         NEXT(mr) = 0; MKDP(rp->nv,mr,t); t->sugar = mr->dl->td;
-                         addd(CO,t,t1,&dp);
-                         dc = gcd;
-                         dp_rest(rp,&t); rp = t;
-                         tt = get_rtime()-t_0; t_a += tt;
-                 }
-         }
-         if ( GenTrace ) {
-                 mulq(ARG3(BDY((LIST)BDY(TraceList))),dc,&cq);
-                 ARG3(BDY((LIST)BDY(TraceList))) = (pointer)cq;
-         }
-         if ( dp )
-                 dp->sugar = sugar;
-         *r = dp;
- final:
-         if ( Print )
-                 fprintf(asir_out,"(%.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g)",
-                         t_p,t_m,t_m1,t_m2,t_s,
-                         t_g,t_a,
-                         pz_t_e, pz_t_d, pz_t_d1, pz_t_c);
  }
- void dp_imul_d();
+ void minsugar(DP_pairs d,DP_pairs *dm,DP_pairs *dr)
- void imulv();
- void _dp_nf_ptozp_mpi(b,g,ps,full,multiple,r)
- NODE b;
- DP g;
- DP *ps;
- int full,multiple;
- DP *r;
  {
-         Obj dmy;
+   int msugar;
-         DP u,dp,rp,t,t1,t2,red,shift;
+   DP_pairs t,dm0,dr0,dmt,drt;
-         Q dc,rc,dcq,rcq,cont,hr,hred,cr,cred,mcred,c,gcd,cq;
-         N gn,tn,cn;
-         NODE l,n0,n1,n2,n3;
-         MP m,mr;
-         int i,n;
-         int hmag,denom;
-         int sugar,psugar;
-         NODE dist;
-         STRING imul;
-         int ndist;
-         int kara_bit;
-         extern int kara_mag;
-         extern int mpi_mag;
-         Q ind;
-         int id;
-         double get_rtime();
-         double t_0,t_00,tt,ttt,t_p,t_m,t_m1,t_m2,t_s,t_g,t_a;
-         if ( !g ) {
+   for ( msugar = d->sugar, t = NEXT(d); t; t = NEXT(t) )
-                 *r = 0; return;
+     if ( t->sugar < msugar )
-         }
+       msugar = t->sugar;
-         pz_t_e = pz_t_d = pz_t_d1 = pz_t_c = 0;
+   dm0 = 0; dr0 = 0;
-         t_p = t_m = t_m1 = t_m2 = t_s = t_g = t_a = 0;
+   for ( t = d; t; t = NEXT(t) ) {
+     if ( t->sugar == msugar ) {
-         denom = Denominator?Denominator:1;
+       NEXTDPP(dm0,dmt);
-         hmag = multiple*HMAG(g)/denom;
+       dmt->dp1 = t->dp1; dmt->dp2 = t->dp2;
-         kara_bit = kara_mag*27; /* XXX */
+       dmt->lcm = t->lcm; dmt->sugar = t->sugar;
-         if ( Dist ) {
+     } else {
-                 dist = BDY(Dist);
+       NEXTDPP(dr0,drt);
-                 ndist = length(dist);
+       drt->dp1 = t->dp1; drt->dp2 = t->dp2;
-         }
+       drt->lcm = t->lcm; drt->sugar = t->sugar;
-         sugar = g->sugar;
+     }
+   }
-         dc = 0; dp = 0; rc = ONE; rp = g;
+   if ( dm0 ) NEXT(dmt) = 0;
-         MKSTR(imul,"dp_imul_index");
+   if ( dr0 ) NEXT(drt) = 0;
+   *dm = dm0; *dr = dr0;
-         for ( ; rp; ) {
-                 for ( u = 0, l = b; l; l = NEXT(l) ) {
-                         if ( dl_redble(BDY(rp)->dl,psh[(int)BDY(l)]) ) {
-                                 t_0 = get_rtime();
-                                 dp_load((int)BDY(l),&red);
-                                 hr = (Q)BDY(rp)->c; hred = (Q)BDY(red)->c;
-                                 gcdn(NM(hr),NM(hred),&gn);
-                                 divsn(NM(hred),gn,&tn); NTOQ(tn,SGN(hred),cr);
-                                 divsn(NM(hr),gn,&tn); NTOQ(tn,SGN(hr),cred);
-                                 tt = get_rtime()-t_0; t_p += tt;
-                                 t_0 = get_rtime();
-                                 dp_subd(rp,red,&shift);
-                                 t_00 = get_rtime();
-                                 if ( Dist && ndist
-                                         && HMAG(rp) > mpi_mag && p_mag((P)cr) > mpi_mag ) {
-                                         if ( Print ) fprintf(asir_out,"~");
-                                         dp_imul_d(rp,cr,&t);
-                                 } else {
-                                         if ( Print ) fprintf(asir_out,"_");
-                                         muldc(CO,rp,(P)cr,&t);
-                                 }
-                                 ttt = get_rtime()-t_00; t_m1 += ttt/dp_nt(rp);
-                                 t_00 = get_rtime();
-                                 chsgnp((P)cred,(P *)&mcred);
-                                 if ( Dist && ndist
-                                         && HMAG(red) > mpi_mag && p_mag((P)mcred) > mpi_mag ) {
-                                         if ( Print ) fprintf(asir_out,"=");
-                                         dp_imul_d(red,mcred,&t1);
-                                 } else {
-                                         if ( Print ) fprintf(asir_out,"_");
-                                         muldc(CO,red,(P)mcred,&t1);
-                                 }
-                                 ttt = get_rtime()-t_00; t_m2 += ttt/dp_nt(red);
-                                 t_00 = get_rtime();
-                                 muld(CO,shift,t1,&t2);
-                                 addd(CO,t,t2,&u);
-                                 tt = get_rtime(); t_m += tt-t_0;
-                                 ttt = get_rtime(); t_s += ttt-t_00;
-                                 psugar = (BDY(rp)->dl->td - BDY(red)->dl->td) + red->sugar;
-                                 sugar = MAX(sugar,psugar);
-                                 if ( !u ) {
-                                         if ( dp )
-                                                 dp->sugar = sugar;
-                                         *r = dp;
-                                         goto final;
-                                 }
-                                 break;
-                         }
-                 }
-                 if ( u ) {
-                         if ( HMAG(u) > hmag ) {
-                                 t_0 = get_rtime();
-                                 if ( Dist && HMAG(u) > mpi_mag ) {
-                                         if ( Print )
-                                                 fprintf(asir_out,"D");
-                                         dp_ptozp_d(dist,ndist,u,&t);
-                                 } else {
-                                         if ( Print )
-                                                 fprintf(asir_out,"L");
-                                         dp_ptozp_d(0,0,u,&t);
-                                 }
-                                 tt = get_rtime()-t_0; t_g += tt;
-                                 t_0 = get_rtime();
-                                 divsn(NM((Q)BDY(u)->c),NM((Q)BDY(t)->c),&cn); NTOQ(cn,1,cont);
-                                 if ( Print ) {
-                                         fprintf(asir_out,"(%d)",p_mag((P)cont)*100/p_mag((P)BDY(u)->c));
-                                         fflush(asir_out);
-                                 }
-                                 mulq(cr,dc,&dcq);
-                                 mulq(cont,rc,&rcq);
-                                 gcdn(SAFENM(dcq),SAFENM(rcq),&gn);
-                                 divsn(SAFENM(dcq),gn,&tn); NTOQ(tn,SGN(dcq),dc);
-                                 divsn(SAFENM(rcq),gn,&tn); NTOQ(tn,SGN(rcq),rc);
-                                 tt = get_rtime()-t_0; t_a += tt;
-                                 rp = t;
-                                 hmag = multiple*HMAG(rp)/denom;
-                         } else {
-                                 t_0 = get_rtime();
-                                 mulq(cr,dc,&dcq); dc = dcq;
-                                 tt = get_rtime()-t_0; t_a += tt;
-                                 rp = u;
-                         }
-                 } else if ( !full ) {
-                         if ( rp ) {
-                                 MKDP(rp->nv,BDY(rp),t); t->sugar = sugar; rp = t;
-                         }
-                         *r = rp;
-                         goto final;
-                 } else {
-                         t_0 = get_rtime();
-                         mulq((Q)BDY(rp)->c,(Q)rc,(Q *)&c);
-                         gcdn(SAFENM(dc),SAFENM(c),&gn); NTOQ(gn,1,gcd);
-                         divsn(SAFENM(dc),gn,&tn); NTOQ(tn,SGN(dc),dcq);
-                         divsn(SAFENM(c),gn,&tn); NTOQ(tn,SGN(c),cq);
-                         muldc(CO,dp,(P)dcq,&t1);
-                         m = BDY(rp); NEWMP(mr); mr->dl = m->dl; mr->c = (P)cq;
-                         NEXT(mr) = 0; MKDP(rp->nv,mr,t); t->sugar = mr->dl->td;
-                         addd(CO,t,t1,&dp);
-                         dc = gcd;
-                         dp_rest(rp,&t); rp = t;
-                         tt = get_rtime()-t_0; t_a += tt;
-                 }
-         }
-         if ( dp )
-                 dp->sugar = sugar;
-         *r = dp;
- final:
-         if ( Print )
-                 fprintf(asir_out,"(%.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g)",
-                         t_p,t_m,t_m1,t_m2,t_s,
-                         t_g,t_a,
-                         pz_t_e, pz_t_d, pz_t_d1, pz_t_c);
  }
- void dp_imul_d(p,q,rp)
+ NODE gb(NODE f,int m,NODE subst)
- DP p;
- Q q;
- DP *rp;
  {
-         int nsep,ndist,i,j,k,l,n;
+   int i,nh,prev,mag,mag0,magt;
-         double t0,t1,t2;
+   NODE r,g,gall;
-         Q *s;
+   DP_pairs d;
-         pointer *b;
+   DP_pairs l;
-         VECT c,cs,ri;
+   DP h,nf,nfm,dp1,dp2;
-         VECT *r;
+   MP mp;
-         MP m;
+   struct oEGT tnf0,tnf1,tnfm0,tnfm1,tpz0,tpz1,tnp0,tnp1;
-         NODE tn,dist,n0,n1,n2;
+   int skip_nf_flag;
-         Obj dmy;
+   double t_0;
-         STRING imul;
+   Q q;
+   int new_sugar;
+   static prev_sugar = -1;
-         extern LIST Dist;
+   Max_mag = 0;
+   Max_coef = 0;
-         if ( !p || !q ) {
+   prev = 1;
-                 *rp = 0; return;
+   doing_f4 = 0;
-         }
+   init_denomlist();
-         dist = BDY(Dist);
+   if ( m ) {
-         for ( tn = dist, ndist = 0; tn; tn = NEXT(tn), ndist++ );
+     psm = (DP *)MALLOC(pslen*sizeof(DP));
-         nsep = ndist + 1;
+     for ( i = 0; i < psn; i++ )
-         for ( m = BDY(p), n = 0; m; m = NEXT(m), n++ );
+       if ( psh[i] && !validhc(psc[i],m,subst) )
-         if ( n <= nsep ) {
+         return 0;
-                 muldc(CO,p,(P)q,rp); return;
+       else
-         }
+         _dp_mod(ps[i],m,subst,&psm[i]);
-         MKSTR(imul,"imulv");
+   }
-         t0 = get_rtime();
+   for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
-         dp_dtov(p,&c);
+     i = (int)BDY(r);
-         sepvect(c,nsep,&cs);
+     d = updpairs(d,g,i);
-         r = (VECT *)CALLOC(nsep,sizeof(VECT *));
+     g = updbase(g,i);
-         for ( i = 0, tn = dist, b = BDY(cs); i < ndist; i++, tn = NEXT(tn) ) {
+     gall = append_one(gall,i);
-                 n0 = mknode(4,BDY(tn),imul,b[i],q);
+   }
-                 Pox_rpc(n0,&dmy);
+   while ( d ) {
-         }
+     l = minp(d,&d);
-         t1 = get_rtime();
+     if ( m ) {
-         im_t_s += t1 - t0;
+       _dp_sp_mod_dup(psm[l->dp1],psm[l->dp2],m,&h);
-         imulv(b[i],q,&r[i]);
+       if ( h )
-         t1 = get_rtime();
+         new_sugar = h->sugar;
-         for ( i = 0, tn = dist; i < ndist; i++, tn = NEXT(tn) ) {
+       get_eg(&tnfm0);
-                 MKNODE(n0,BDY(tn),0);
+       _dp_nf_mod_destructive(gall,h,psm,m,0,&nfm);
-                 Pox_pop_local(n0,&r[i]);
+       get_eg(&tnfm1); add_eg(&eg_nfm,&tnfm0,&tnfm1);
-                 if ( OID(r[i]) == O_ERR ) {
+     } else
-                         printexpr(CO,(Obj)r[i]);
+       nfm = (DP)1;
-                         error("dp_imul_d : aborted");
+     if ( nfm ) {
-                 }
+       if ( Demand ) {
-         }
+         if ( dp_load_t(psn,&nf) ) {
-         t2 = get_rtime();
+           skip_nf_flag = 1;
-         im_t_r += t2 - t1;
+           goto skip_nf;
-         s = (Q *)CALLOC(n,sizeof(Q));
+         } else {
-         for ( i = j = 0; i < nsep; i++ ) {
+           skip_nf_flag = 0;
-                 for ( k = 0, ri = r[i], l = ri->len; k < l; k++, j++ ) {
+           dp_load(l->dp1,&dp1); dp_load(l->dp2,&dp2);
-                         s[j] = (Q)BDY(ri)[k];
+           dp_sp(dp1,dp2,&h);
-                 }
+         }
-         }
+       } else
-         dp_vtod(s,p,rp);
+         dp_sp(ps[l->dp1],ps[l->dp2],&h);
+       if ( GenTrace ) {
+         STOQ(l->dp1,q); ARG1(BDY((LIST)BDY(NEXT(TraceList)))) = q;
+         STOQ(l->dp2,q); ARG1(BDY((LIST)BDY(TraceList))) = q;
+       }
+       if ( h )
+         new_sugar = h->sugar;
+       get_eg(&tnf0);
+       t_0 = get_rtime();
+       if ( PCoeffs || dp_fcoeffs )
+         _dp_nf(gall,h,ps,!Top,&nf);
+       else
+         _dp_nf_z(gall,h,ps,!Top,DP_Multiple,&nf);
+       if ( DP_Print && nf )
+         fprintf(asir_out,"(%.3g)",get_rtime()-t_0);
+       get_eg(&tnf1); add_eg(&eg_nf,&tnf0,&tnf1);
+     } else
+       nf = 0;
+ skip_nf:
+     if ( nf ) {
+       NZR++;
+       get_eg(&tpz0);
+       prim_part(nf,0,&h);
+       get_eg(&tpz1); add_eg(&eg_pz,&tpz0,&tpz1);
+       add_denomlist((P)BDY(h)->c);
+       get_eg(&tnp0);
+       if ( Demand && skip_nf_flag )
+         nh = newps_nosave(h,m,subst);
+       else
+         nh = newps(h,m,subst);
+       get_eg(&tnp1); add_eg(&eg_np,&tnp0,&tnp1);
+       if ( nh < 0 )
+         return 0;
+       d = updpairs(d,g,nh);
+       g = updbase(g,nh);
+       gall = append_one(gall,nh);
+       if ( !dp_fcoeffs && ShowMag ) {
+         for ( mag = 0, mag0 = 0, mp = BDY(h); mp; mp = NEXT(mp) ) {
+           magt = p_mag((P)mp->c);
+           mag0 = MAX(mag0,magt);
+           mag += magt;
+         }
+         Max_coef = MAX(Max_coef,mag0);
+         Max_mag = MAX(Max_mag,mag);
+       }
+       if ( DP_Print ) {
+         if ( !prev )
+           fprintf(asir_out,"\n");
+         print_split_e(&tnf0,&tnf1); print_split_e(&tpz0,&tpz1);
+         printdl(psh[nh]);
+         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]);
+         if ( ShowMag )
+           fprintf(asir_out,",mag=(%d,%d)",mag,mag0);
+         fprintf(asir_out,"\n"); fflush(asir_out);
+       } else if ( DP_PrintShort ) {
+         fprintf(asir_out,"+"); fflush(asir_out);
+       }
+       prev = 1;
+     } else {
+       if ( m )
+         add_eg(&eg_znfm,&tnfm0,&tnfm1);
+       ZR++;
+       if ( DP_Print || DP_PrintShort ) {
+         if ( new_sugar != prev_sugar ) {
+           fprintf(asir_out,"[%d]",new_sugar);
+           prev_sugar = new_sugar;
+         }
+         fprintf(asir_out,"."); fflush(asir_out); prev = 0;
+       }
+     }
+   }
+   if ( DP_Print || DP_PrintShort )
+     fprintf(asir_out,"gb done\n");
+   return g;
  }
- void imulv(w,c,rp)
+ NODE gb_mod(NODE f,int m)
- VECT w;
- Q c;
- VECT *rp;
  {
-         int n,i;
+   int i,nh,prev;
-         VECT r;
+   NODE r,g,gall;
+   DP_pairs d;
+   DP_pairs l;
+   DP h,nf;
+   struct oEGT tnfm0,tnfm1,tpz0,tpz1;
-         n = w->len;
+   prev = 1;
-         MKVECT(r,n); *rp = r;
+   for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
-         for ( i = 0; i < n; i++ )
+     i = (int)BDY(r);
-                 mulq((Q)BDY(w)[i],(Q)c,(Q *)&BDY(r)[i]);
+     d = updpairs(d,g,i);
+     g = updbase(g,i);
+     gall = append_one(gall,i);
+   }
+   while ( d ) {
+     l = minp(d,&d);
+     if ( PCoeffs ) {
+       dp_sp_mod(ps[l->dp1],ps[l->dp2],m,&h);
+       get_eg(&tnfm0);
+       dp_nf_mod(gall,h,ps,m,!Top,&nf);
+     } else {
+       _dp_sp_mod_dup(ps[l->dp1],ps[l->dp2],m,&h);
+       get_eg(&tnfm0);
+       _dp_nf_mod_destructive(gall,h,ps,m,!Top,&nf);
+     }
+     get_eg(&tnfm1); add_eg(&eg_nfm,&tnfm0,&tnfm1);
+     if ( nf ) {
+       NZR++;
+       get_eg(&tpz0);
+       prim_part(nf,m,&h);
+       get_eg(&tpz1); add_eg(&eg_pz,&tpz0,&tpz1);
+       nh = newps_mod(h,m);
+       if ( nh < 0 )
+         return 0;
+       d = updpairs(d,g,nh);
+       g = updbase(g,nh);
+       gall = append_one(gall,nh);
+       if ( DP_Print ) {
+         if ( !prev )
+           fprintf(asir_out,"\n");
+         print_split_eg(&tnfm0,&tnfm1); fflush(asir_out);
+         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]);
+         printdl(psh[nh]); fprintf(asir_out,"\n"); fflush(asir_out);
+       } else if ( DP_PrintShort ) {
+         fprintf(asir_out,"+"); fflush(asir_out);
+       }
+       prev = 1;
+     } else {
+       add_eg(&eg_znfm,&tnfm0,&tnfm1);
+       ZR++;
+       if ( DP_Print || DP_PrintShort ) {
+         fprintf(asir_out,"."); fflush(asir_out); prev = 0;
+       }
+     }
+   }
+   if ( DP_Print || DP_PrintShort )
+     fprintf(asir_out,"gb_mod done\n");
+   return g;
  }
- DP_pairs updpairs( d, g, t)
+ DP_pairs updpairs( DP_pairs d, NODE /* of index */ g, int t)
- DP_pairs d;
- NODE /* of index */ g;
- int t;
  {
-         register DP_pairs d1, dd, nd;
+   register DP_pairs d1, dd, nd;
-         struct oEGT tup0,tup1;
+   int dl,dl1;
-         int dl,dl1;
-         if ( !g ) return d;
+   if ( !g ) return d;
-         get_eg(&tup0);
+   if ( !NoCriB && d ) {
-         if ( !NoCriB && d ) {
+     dl = DPPlength(d);
-                 dl = DPPlength(d);
+     d = criterion_B( d, t );
-                 d = criterion_B( d, t );
+     dl -= DPPlength(d); N_BP += dl;
-                 dl -= DPPlength(d); NBP += dl;
+   }
-         }
+   d1 = newpairs( g, t );
-         d1 = newpairs( g, t );
+   if ( NEXT(d1) ) {
-         if ( NEXT(d1) ) {
+     dl = DPPlength(d1); TP += dl;
-                 dl = DPPlength(d1); TP += dl;
+     d1 = criterion_M( d1 );
-                 d1 = criterion_M( d1 );
+     dl1 = DPPlength(d1); NMP += (dl-dl1); dl = dl1;
-                 dl1 = DPPlength(d1); NMP += (dl-dl1); dl = dl1;
+     d1 = criterion_F( d1 );
-                 d1 = criterion_F( d1 );
+     dl1 = DPPlength(d1); NFP += (dl-dl1); dl = dl1;
-                 dl1 = DPPlength(d1); NFP += (dl-dl1); dl = dl1;
+   } else
-         } else
+     dl = 1;
-                 dl = 1;
+   if ( !do_weyl )
-         if ( !do_weyl )
+     for ( dd = 0; d1; d1 = nd ) {
-                 for ( dd = 0; d1; d1 = nd ) {
+       nd = NEXT(d1);
-                         nd = NEXT(d1);
+       if ( !criterion_2( d1->dp1, d1->dp2 ) ) {
-                         if ( !criterion_2( d1->dp1, d1->dp2 ) ) {
+         NEXT(d1) = dd;
-                                 NEXT(d1) = dd;
+         dd = d1;
-                                 dd = d1;
+       }
-                         }
+     }
-                 }
+   else
-         else
+     dd = d1;
-                 dd = d1;
+   dl1 = DPPlength(dd); NDP += (dl-dl1);
-         dl1 = DPPlength(dd); NDP += (dl-dl1);
+   if ( !(nd = d) ) return dd;
-         get_eg(&tup1);
+   while ( nd = NEXT(d1 = nd) ) ;
-         add_eg(&eg_up,&tup0,&tup1);
+   NEXT(d1) = dd;
-         if ( !(nd = d) ) return dd;
+   return d;
-         while ( nd = NEXT(d1 = nd) ) ;
-         NEXT(d1) = dd;
-         return d;
  }
- DP_pairs newpairs( g, t )
+ DP_pairs newpairs( NODE /* of index */ g, int t )
- NODE /* of index */ g;
- register int t;
  {
-         register NODE r;
+   register NODE r;
-         register DL tdl = psh[t];
+   register DL tdl = psh[t];
-         register int ts;
+   register int ts;
-         register DP_pairs p, last;
+   register DP_pairs p, last;
-         int dp;
+   int dp;
-         register DL dl;
+   register DL dl;
-         register int s;
+   register int s;
-         ts = pss[t] - tdl->td;
+   ts = pss[t] - tdl->td;
-         for ( last = 0, r = g; r; r = NEXT(r) ) {
+   for ( last = 0, r = g; r; r = NEXT(r) ) {
-                 NEXT(p = NEWDP_pairs) = last;
+     NEXT(p = NEWDP_pairs) = last;
-                 last = p;
+     last = p;
-                 dp = p->dp1 = (int)BDY(r);  p->dp2 = t;
+     dp = p->dp1 = (int)BDY(r);  p->dp2 = t;
-                 p->lcm = lcm_of_DL(CNVars, dl = psh[dp], tdl, (DL)0 );
+     p->lcm = lcm_of_DL(CNVars, dl = psh[dp], tdl, (DL)0 );
  #if 0
-                 if ( do_weyl )
+     if ( do_weyl )
-                         p->sugar = dl_weight(p->lcm);
+       p->sugar = dl_weyl_weight(p->lcm);
-                 else
+     else
  #endif
-                         p->sugar = (ts > (s = pss[dp] - dl->td) ? ts : s) + p->lcm->td;
+       p->sugar = (ts > (s = pss[dp] - dl->td) ? ts : s) + p->lcm->td;
-         }
+   }
-         return last;
+   return last;
  }
- DP_pairs criterion_B( d, s )
+ DP_pairs criterion_B( DP_pairs d, int s )
- register DP_pairs d;
- int s;
  {
-         register DP_pairs dd, p;
+   register DP_pairs dd, p;
-         register DL tij, t = psh[s], dltmp;
+   register DL tij, t = psh[s], dltmp;
-         if ( !d ) return 0;
+   if ( !d ) return 0;
-         NEWDL( dltmp, CNVars );
+   NEWDL( dltmp, CNVars );
-         for ( dd = 0; d; d = p ) {
+   for ( dd = 0; d; d = p ) {
-                 p = NEXT(d),
+     p = NEXT(d),
-                 tij = d->lcm;
+     tij = d->lcm;
-                 if ( tij->td != lcm_of_DL(CNVars, tij, t, dltmp )->td
+     if ( tij->td != lcm_of_DL(CNVars, tij, t, dltmp )->td
-                         || !dl_equal(CNVars, tij, dltmp )
+       || !dl_equal(CNVars, tij, dltmp )
-                         || (tij->td == lcm_of_DL(CNVars, psh[d->dp1], t, dltmp )->td
+       || (tij->td == lcm_of_DL(CNVars, psh[d->dp1], t, dltmp )->td
-                             && dl_equal(CNVars, dltmp, tij ))
+           && dl_equal(CNVars, dltmp, tij ))
-                         || (tij->td == lcm_of_DL(CNVars, psh[d->dp2], t, dltmp )->td
+       || (tij->td == lcm_of_DL(CNVars, psh[d->dp2], t, dltmp )->td
-                             && dl_equal(CNVars, dltmp, tij )) ) {
+           && dl_equal(CNVars, dltmp, tij )) ) {
-                         NEXT(d) = dd;
+       NEXT(d) = dd;
-                         dd = d;
+       dd = d;
-                 }
+     }
-         }
+   }
-         return dd;
+   return dd;
  }
- DP_pairs criterion_M( d1 )
+ DP_pairs criterion_M( DP_pairs d1 )
- DP_pairs d1;
  {
-         register DP_pairs dd, e, d3, d2, p;
+   register DP_pairs dd, e, d3, d2, p;
-         register DL itdl, jtdl;
+   register DL itdl, jtdl;
-         register int itdltd, jtdltd;
+   register int itdltd, jtdltd;
-         for ( dd = 0, e = d1; e; e = d3 ) {
+   for ( dd = 0, e = d1; e; e = d3 ) {
-                 if ( !(d2 = NEXT(e)) ) {
+     if ( !(d2 = NEXT(e)) ) {
-                         NEXT(e) = dd;
+       NEXT(e) = dd;
-                         return e;
+       return e;
-                 }
+     }
-                 itdltd = (itdl = e->lcm)->td;
+     itdltd = (itdl = e->lcm)->td;
-                 for ( d3 = 0; d2; d2 = p ) {
+     for ( d3 = 0; d2; d2 = p ) {
-                         p = NEXT(d2),
+       p = NEXT(d2),
-                         jtdltd = (jtdl = d2->lcm)->td;
+       jtdltd = (jtdl = d2->lcm)->td;
-                         if ( jtdltd == itdltd  )
+       if ( jtdltd == itdltd  )
-                                 if ( dl_equal(CNVars, itdl, jtdl ) ) ;
+         if ( dl_equal(CNVars, itdl, jtdl ) ) ;
-                                 else if ( dl_redble( jtdl, itdl ) ) continue;
+         else if ( dl_redble( jtdl, itdl ) ) continue;
-                                 else if ( dl_redble( itdl, jtdl ) ) goto delit;
+         else if ( dl_redble( itdl, jtdl ) ) goto delit;
-                                 else ;
+         else ;
-                         else if ( jtdltd > itdltd )
+       else if ( jtdltd > itdltd )
-                                 if ( dl_redble( jtdl, itdl ) ) continue;
+         if ( dl_redble( jtdl, itdl ) ) continue;
-                                 else ;
+         else ;
-                         else if ( dl_redble( itdl, jtdl ) ) goto delit;
+       else if ( dl_redble( itdl, jtdl ) ) goto delit;
-                         NEXT(d2) = d3;
+       NEXT(d2) = d3;
-                         d3 = d2;
+       d3 = d2;
-                 }
+     }
-                 NEXT(e) = dd;
+     NEXT(e) = dd;
-                 dd = e;
+     dd = e;
-                 continue;
+     continue;
-                 /**/
+     /**/
-         delit:  NEXT(d2) = d3;
+   delit:  NEXT(d2) = d3;
-                 d3 = d2;
+     d3 = d2;
-                 for ( ; p; p = d2 ) {
+     for ( ; p; p = d2 ) {
-                         d2 = NEXT(p);
+       d2 = NEXT(p);
-                         NEXT(p) = d3;
+       NEXT(p) = d3;
-                         d3 = p;
+       d3 = p;
-                 }
+     }
-         }
+   }
-         return dd;
+   return dd;
  }
- static DP_pairs collect_pairs_of_hdlcm( d1, prest )
+ static DP_pairs collect_pairs_of_hdlcm( DP_pairs d1, DP_pairs *prest )
- DP_pairs d1, *prest;
  {
-         register DP_pairs w, p, r, s;
+   register DP_pairs w, p, r, s;
-         register DL ti;
+   register DL ti;
-         register int td;
+   register int td;
-         td = (ti = (w = d1)->lcm)->td;
+   td = (ti = (w = d1)->lcm)->td;
-         s = NEXT(w);
+   s = NEXT(w);
-         NEXT(w) = 0;
+   NEXT(w) = 0;
-         for ( r = 0; s; s = p ) {
+   for ( r = 0; s; s = p ) {
-                 p = NEXT(s);
+     p = NEXT(s);
-                 if ( td == s->lcm->td && dl_equal(CNVars, ti, s->lcm ) )
+     if ( td == s->lcm->td && dl_equal(CNVars, ti, s->lcm ) )
-                 {
+     {
-                         NEXT(s) = w;
+       NEXT(s) = w;
-                         w = s;
+       w = s;
-                 } else {
+     } else {
-                         NEXT(s) = r;
+       NEXT(s) = r;
-                         r = s;
+       r = s;
-                 }
+     }
-         }
+   }
-         *prest = r;
+   *prest = r;
-         return w;
+   return w;
  }
- int criterion_2( dp1, dp2 )
+ int criterion_2( int dp1, int dp2 )
- int dp1, dp2;
  {
-         register int i, *d1, *d2;
+   register int i, *d1, *d2;
-         d1 = psh[dp1]->d,  d2 = psh[dp2]->d;
+   d1 = psh[dp1]->d,  d2 = psh[dp2]->d;
-         for ( i = CNVars; --i >= 0; d1++, d2++ )
+   for ( i = CNVars; --i >= 0; d1++, d2++ )
-                 if ( (*d1 <= *d2 ? *d1 : *d2) > 0  ) return 0;
+     if ( (*d1 <= *d2 ? *d1 : *d2) > 0  ) return 0;
-         return 1;
+   return 1;
  }
- DP_pairs criterion_F( d1 )
+ DP_pairs criterion_F( DP_pairs d1 )
- DP_pairs d1;
  {
-         DP_pairs rest, head;
+   DP_pairs rest, head;
-         register DP_pairs last, p, r, w;
+   register DP_pairs last, p, r, w;
-         register int s;
+   register int s;
-         for ( head = last = 0, p = d1; NEXT(p); ) {
+   for ( head = last = 0, p = d1; NEXT(p); ) {
-                 s = (r = w = collect_pairs_of_hdlcm( p, &rest ))->sugar;
+     s = (r = w = collect_pairs_of_hdlcm( p, &rest ))->sugar;
-                 while ( w = NEXT(w) )
+     while ( w = NEXT(w) )
-                         if ( criterion_2( w->dp1, w->dp2 ) ) {
+       if ( !do_weyl && criterion_2( w->dp1, w->dp2 ) ) {
-                                 r = w;
+         r = w;
-                                 break;
+         break;
-                         } else if ( w->sugar < s ) s = (r = w)->sugar;
+       } else if ( w->sugar < s ) s = (r = w)->sugar;
-                 if ( last ) NEXT(last) = r;
+     if ( last ) NEXT(last) = r;
-                 else head = r;
+     else head = r;
-                 NEXT(last = r) = 0;
+     NEXT(last = r) = 0;
-                 if ( !(p = rest) ) return head;
+     if ( !(p = rest) ) return head;
-         }
+   }
-         if ( !last ) return p;
+   if ( !last ) return p;
-         NEXT(last) = p;
+   NEXT(last) = p;
-         return head;
+   return head;
  }
- NODE updbase(g,t)
+ NODE updbase(NODE g,int t)
- NODE g;
- int t;
  {
-         g = remove_reducibles(g,t);
+   g = remove_reducibles(g,t);
-         g = append_one(g,t);
+   g = append_one(g,t);
-         return g;
+   return g;
  }
- NODE /* of index */ remove_reducibles( nd, newdp )
+ NODE /* of index */ remove_reducibles(NODE /* of index */ nd, int newdp )
- NODE /* of index */ nd;
- int newdp;
  {
-         register DL dl, dln;
+   register DL dl, dln;
-         register NODE last, p, head;
+   register NODE last, p, head;
-         register int td;
+   register int td;
-         dl = psh[newdp];
+   dl = psh[newdp];
-         td = dl->td;
+   td = dl->td;
-         for ( head = last = 0, p = nd; p; ) {
+   for ( head = last = 0, p = nd; p; ) {
-                 dln = psh[(int)BDY(p)];
+     dln = psh[(int)BDY(p)];
-                 if ( dln->td >= td && dl_redble( dln, dl ) ) {
+     if ( dln->td >= td && dl_redble( dln, dl ) ) {
-                         p = NEXT(p);
+       p = NEXT(p);
-                         if ( last ) NEXT(last) = p;
+       if ( last ) NEXT(last) = p;
-                 } else {
+     } else {
-                         if ( !last ) head = p;
+       if ( !last ) head = p;
-                         p = NEXT(last = p);
+       p = NEXT(last = p);
-                 }
+     }
-         }
+   }
-         return head;
+   return head;
  }
- int dl_redble( dl1, dl2 )
+ int dl_redble(DL dl1,DL dl2)
- DL dl1, dl2;
  {
-         register int n, *d1, *d2;
+   register int n, *d1, *d2;
-         for ( d1 = dl1->d, d2 = dl2->d, n = CNVars; --n >= 0; d1++, d2++ )
+   for ( d1 = dl1->d, d2 = dl2->d, n = CNVars; --n >= 0; d1++, d2++ )
-                 if ( *d1 < *d2 ) return 0;
+     if ( *d1 < *d2 ) return 0;
-         return 1;
+   return 1;
  }
- int dl_weight(dl)
+ #if 0
- DL dl;
+ int dl_weyl_weight(DL dl)
  {
-         int n,w,i;
+   int n,w,i;
-         n = CNVars/2;
+   n = CNVars/2;
-         for ( i = 0, w = 0; i < n; i++ )
+   for ( i = 0, w = 0; i < n; i++ )
-                 w += (-dl->d[i]+dl->d[n+i]);
+     w += (-dl->d[i]+dl->d[n+i]);
-         return w;
+   return w;
  }
+ #endif
- int gbcheck(f)
+ int gbcheck(NODE f)
- NODE f;
  {
-         int i;
+   int i;
-         NODE r,g,gall;
+   NODE r,g,gall;
-         DP_pairs d,l;
+   DP_pairs d,l;
-         DP h,nf,dp1,dp2;
+   DP h,nf,dp1,dp2;
-         struct oEGT tmp0,tmp1;
+   struct oEGT tmp0,tmp1;
-         if ( NoGC )
+   if ( NoGC )
-                 return 1;
+     return 1;
-         for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
+   for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {
-                 i = (int)BDY(r);
+     i = (int)BDY(r);
-                 d = updpairs(d,g,i);
+     d = updpairs(d,g,i);
-                 g = updbase(g,i);
+     g = updbase(g,i);
-                 gall = append_one(gall,i);
+     gall = append_one(gall,i);
-         }
+   }
-         if ( Print || PrintShort ) {
+   if ( DP_Print || DP_PrintShort ) {
-                 fprintf(asir_out,"gbcheck total %d pairs\n",DPPlength(d)); fflush(asir_out);
+     fprintf(asir_out,"gbcheck total %d pairs\n",DPPlength(d)); fflush(asir_out);
-         }
+   }
-         while ( d ) {
+   while ( d ) {
-                 l = d; d = NEXT(d);
+     l = d; d = NEXT(d);
-                 get_eg(&tmp0);
+     get_eg(&tmp0);
-                 dp_load(l->dp1,&dp1); dp_load(l->dp2,&dp2); dp_sp(dp1,dp2,&h);
+     dp_load(l->dp1,&dp1); dp_load(l->dp2,&dp2);
-                 _dp_nf(gall,h,ps,1,&nf);
+     dp_sp(dp1,dp2,&h);
-                 get_eg(&tmp1); add_eg(&eg_gc,&tmp0,&tmp1);
+ /* fprintf(stderr,"{%d,%d}",l->dp1,l->dp2); */
-                 if ( Print || PrintShort ) {
+     _dp_nf(gall,h,ps,1,&nf);
-                         fprintf(asir_out,"."); fflush(asir_out);
+     get_eg(&tmp1); add_eg(&eg_gc,&tmp0,&tmp1);
-                 }
+     if ( DP_Print || DP_PrintShort ) {
-                 if ( nf )
+       fprintf(asir_out,"."); fflush(asir_out);
-                         return 0;
+     }
-         }
+     if ( nf )
-         if ( Print || PrintShort )
+       return 0;
-                 fprintf(asir_out,"\n");
+   }
-         return 1;
+   if ( DP_Print || DP_PrintShort )
+     fprintf(asir_out,"\n");
+   return 1;
  }
- int membercheck(f,x)
+ void gbcheck_list(NODE f,int n,VECT *gp,LIST *pp)
- NODE f,x;
  {
-         DP g;
+   int i;
-         struct oEGT tmp0,tmp1;
+   NODE r,g,gall,u,u0,t;
+   VECT vect;
+   LIST pair;
+   DP_pairs d,l;
+   Q q1,q2;
-         if ( NoMC )
+   /* we need the following settings */
-                 return 1;
+   NVars = CNVars = n;
-         if ( Print || PrintShort ) {
+   setup_arrays(f,0,&r);
-                 fprintf(asir_out,"membercheck\n"); fflush(asir_out);
+   for ( gall = g = 0, d = 0; r; r = NEXT(r) ) {
-         }
+     i = (int)BDY(r);
-         for ( ; f; f = NEXT(f) ) {
+     d = updpairs(d,g,i);
-                 get_eg(&tmp0);
+     g = updbase(g,i);
-                 _dp_nf(x,(DP)BDY(f),ps,1,&g);
+     gall = append_one(gall,i);
-                 get_eg(&tmp1); add_eg(&eg_mc,&tmp0,&tmp1);
+   }
-                 if ( Print ) {
+   NEWVECT(vect); vect->len = psn; vect->body = (pointer)ps;
-                         print_split_eg(&tmp0,&tmp1); fflush(asir_out);
+   *gp = vect;
-                 } else if ( PrintShort ) {
-                         fprintf(asir_out,"."); fflush(asir_out);
+   for ( u0 = 0, l = d; l; l = NEXT(l) ) {
-                 }
+     NEXTNODE(u0,u);
-                 if ( g )
+     STOQ(l->dp1,q1);
-                         return 0;
+     STOQ(l->dp2,q2);
-         }
+     t = mknode(2,q1,q2);
-         if ( Print || PrintShort )
+     MKLIST(pair,t);
-                 fprintf(asir_out,"\n");
+     BDY(u) = (pointer)pair;
-         return 1;
+   }
+   if ( u0 )
+     NEXT(u) = 0;
+   MKLIST(*pp,u0);
  }
- void dp_set_flag(name,value)
+ int membercheck(NODE f,NODE x)
- Obj name,value;
  {
-         char *n;
+   DP g;
-         int v;
+   struct oEGT tmp0,tmp1;
-         if ( OID(name) != O_STR )
+   if ( NoMC )
-                 return;
+     return 1;
-         n = BDY((STRING)name);
+   if ( DP_Print || DP_PrintShort ) {
-         if ( !strcmp(n,"Demand") ) {
+     fprintf(asir_out,"membercheck\n"); fflush(asir_out);
-                 Demand = value ? BDY((STRING)value) : 0; return;
+   }
-         }
+   for ( ; f; f = NEXT(f) ) {
-         if ( !strcmp(n,"Dist") ) {
+     get_eg(&tmp0);
-                 Dist = (LIST)value; return;
+     _dp_nf(x,(DP)BDY(f),ps,1,&g);
-         }
+     get_eg(&tmp1); add_eg(&eg_mc,&tmp0,&tmp1);
-         if ( value && OID(value) != O_N )
+     if ( DP_Print ) {
-                 return;
+       print_split_eg(&tmp0,&tmp1); fflush(asir_out);
-         v = QTOS((Q)value);
+     } else if ( DP_PrintShort ) {
-         if ( !strcmp(n,"NoSugar") )
+       fprintf(asir_out,"."); fflush(asir_out);
-                 NoSugar = v;
+     }
-         else if ( !strcmp(n,"NoCriB") )
+     if ( g )
-                 NoCriB = v;
+       return 0;
-         else if ( !strcmp(n,"NoGC") )
+   }
-                 NoGC = v;
+   if ( DP_Print || DP_PrintShort )
-         else if ( !strcmp(n,"NoMC") )
+     fprintf(asir_out,"\n");
-                 NoMC = v;
+   return 1;
-         else if ( !strcmp(n,"NoRA") )
-                 NoRA = v;
-         else if ( !strcmp(n,"NoGCD") )
-                 NoGCD = v;
-         else if ( !strcmp(n,"Top") )
-                 Top = v;
-         else if ( !strcmp(n,"ShowMag") )
-                 ShowMag = v;
-         else if ( !strcmp(n,"PrintShort") )
-                 PrintShort = v;
-         else if ( !strcmp(n,"Print") )
-                 Print = v;
-         else if ( !strcmp(n,"Stat") )
-                 Stat = v;
-         else if ( !strcmp(n,"Reverse") )
-                 Reverse = v;
-         else if ( !strcmp(n,"InterReduce") )
-                 InterReduce = v;
-         else if ( !strcmp(n,"Multiple") )
-                 Multiple = v;
-         else if ( !strcmp(n,"Denominator") )
-                 Denominator = v;
-         else if ( !strcmp(n,"PtozpRA") )
-                 PtozpRA = v;
-         else if ( !strcmp(n,"GenTrace") )
-                 GenTrace = v;
-         else if ( !strcmp(n,"OXCheck") )
-                 OXCheck = v;
  }
- void dp_make_flaglist(list)
+ void dp_set_flag(Obj name,Obj value)
- LIST *list;
  {
-         Q v;
+   char *n;
-         STRING name,path;
+   int v;
-         NODE n,n1;
+   Q ratio;
-         STOQ(Multiple,v); MKNODE(n,v,0); MKSTR(name,"Multiple"); MKNODE(n1,name,n); n = n1;
+   if ( OID(name) != O_STR )
-         STOQ(Denominator,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Denominator"); MKNODE(n1,name,n); n = n1;
+     return;
-         MKNODE(n1,Dist,n); n = n1; MKSTR(name,"Dist"); MKNODE(n1,name,n); n = n1;
+   n = BDY((STRING)name);
-         STOQ(InterReduce,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"InterReduce"); MKNODE(n1,name,n); n = n1;
+   if ( !strcmp(n,"Demand") ) {
-         STOQ(Reverse,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Reverse"); MKNODE(n1,name,n); n = n1;
+     Demand = value ? BDY((STRING)value) : 0; return;
-         STOQ(Stat,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Stat"); MKNODE(n1,name,n); n = n1;
+   }
-         STOQ(Print,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Print"); MKNODE(n1,name,n); n = n1;
+   if ( !strcmp(n,"Dist") ) {
-         STOQ(OXCheck,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"OXCheck"); MKNODE(n1,name,n); n = n1;
+     Dist = (LIST)value; return;
-         STOQ(GenTrace,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"GenTrace"); MKNODE(n1,name,n); n = n1;
+   }
-         STOQ(PtozpRA,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"PtozpRA"); MKNODE(n1,name,n); n = n1;
+   if ( !strcmp(n,"Content") ) {
-         STOQ(ShowMag,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"ShowMag"); MKNODE(n1,name,n); n = n1;
+     ratio = (Q)value;
-         STOQ(Top,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Top"); MKNODE(n1,name,n); n = n1;
+     if ( ratio ) {
-         STOQ(NoGCD,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoGCD"); MKNODE(n1,name,n); n = n1;
+       DP_Multiple = BD(NM(ratio))[0];
-         STOQ(NoRA,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoRA"); MKNODE(n1,name,n); n = n1;
+       Denominator = INT(ratio) ? 1 : BD(DN(ratio))[0];
-         STOQ(NoMC,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoMC"); MKNODE(n1,name,n); n = n1;
+     } else {
-         STOQ(NoGC,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoGC"); MKNODE(n1,name,n); n = n1;
+       DP_Multiple = 0;
-         STOQ(NoCriB,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoCriB"); MKNODE(n1,name,n); n = n1;
+       Denominator = 1;
-         STOQ(NoSugar,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoSugar"); MKNODE(n1,name,n); n = n1;
+     }
-         if ( Demand )
+   }
-                 MKSTR(path,Demand);
+   if ( value && OID(value) != O_N )
-         else
+     return;
-                 path = 0;
+   v = QTOS((Q)value);
-         MKNODE(n1,path,n); n = n1; MKSTR(name,"Demand"); MKNODE(n1,name,n); n = n1;
+   if ( !strcmp(n,"NoSugar") )
-         MKLIST(*list,n);
+     NoSugar = v;
+   else if ( !strcmp(n,"NoCriB") )
+     NoCriB = v;
+   else if ( !strcmp(n,"NoGC") )
+     NoGC = v;
+   else if ( !strcmp(n,"NoMC") )
+     NoMC = v;
+   else if ( !strcmp(n,"NoRA") )
+     NoRA = v;
+   else if ( !strcmp(n,"NoGCD") )
+     NoGCD = v;
+   else if ( !strcmp(n,"Top") )
+     Top = v;
+   else if ( !strcmp(n,"ShowMag") )
+     ShowMag = v;
+   else if ( !strcmp(n,"PrintShort") )
+     DP_PrintShort = v;
+   else if ( !strcmp(n,"Print") )
+     DP_Print = v;
+   else if ( !strcmp(n,"NFStat") )
+     DP_NFStat = v;
+   else if ( !strcmp(n,"Stat") )
+     Stat = v;
+   else if ( !strcmp(n,"Reverse") )
+     Reverse = v;
+   else if ( !strcmp(n,"Multiple") )
+     DP_Multiple = v;
+   else if ( !strcmp(n,"Denominator") )
+     Denominator = v;
+   else if ( !strcmp(n,"PtozpRA") )
+     PtozpRA = v;
+   else if ( !strcmp(n,"GenTrace") )
+     GenTrace = v;
+   else if ( !strcmp(n,"OXCheck") )
+     OXCheck = v;
+   else if ( !strcmp(n,"GenSyz") )
+     GenSyz = v;
+   else if ( !strcmp(n,"OneZeroHomo") )
+     OneZeroHomo = v;
+   else if ( !strcmp(n,"MaxDeg") )
+     MaxDeg = v;
  }
- #define DELIM '/'
+ void dp_make_flaglist(LIST *list)
+ {
+   Q v,nm,dn;
+   STRING name,path;
+   NODE n,n1;
- #if defined(THINK_C)
+ #if 0
- #undef DELIM
+   STOQ(DP_Multiple,v); MKNODE(n,v,0); MKSTR(name,"DP_Multiple"); MKNODE(n1,name,n); n = n1;
- #define DELIM ':'
+   STOQ(Denominator,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Denominator"); MKNODE(n1,name,n); n = n1;
+ #else
+   if ( DP_Multiple ) {
+     STOQ(DP_Multiple,nm); STOQ(Denominator,dn); divq(nm,dn,&v);
+   } else
+     v = 0;
+   MKNODE(n,v,0); MKSTR(name,"Content"); MKNODE(n1,name,n); n = n1;
  #endif
+   MKNODE(n1,Dist,n); n = n1; MKSTR(name,"Dist"); MKNODE(n1,name,n); n = n1;
+   STOQ(Reverse,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Reverse"); MKNODE(n1,name,n); n = n1;
+   STOQ(Stat,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Stat"); MKNODE(n1,name,n); n = n1;
+   STOQ(DP_Print,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Print"); MKNODE(n1,name,n); n = n1;
+   STOQ(DP_PrintShort,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"PrintShort"); MKNODE(n1,name,n); n = n1;
+   STOQ(DP_NFStat,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NFStat"); MKNODE(n1,name,n); n = n1;
+   STOQ(OXCheck,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"OXCheck"); MKNODE(n1,name,n); n = n1;
+   STOQ(GenTrace,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"GenTrace"); MKNODE(n1,name,n); n = n1;
+   STOQ(GenSyz,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"GenSyz"); MKNODE(n1,name,n); n = n1;
+   STOQ(MaxDeg,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"MaxDeg"); MKNODE(n1,name,n); n = n1;
+   STOQ(OneZeroHomo,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"OneZeroHomo"); MKNODE(n1,name,n); n = n1;
+   STOQ(PtozpRA,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"PtozpRA"); MKNODE(n1,name,n); n = n1;
+   STOQ(ShowMag,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"ShowMag"); MKNODE(n1,name,n); n = n1;
+   STOQ(Top,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Top"); MKNODE(n1,name,n); n = n1;
+   STOQ(NoGCD,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoGCD"); MKNODE(n1,name,n); n = n1;
+   STOQ(NoRA,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoRA"); MKNODE(n1,name,n); n = n1;
+   STOQ(NoMC,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoMC"); MKNODE(n1,name,n); n = n1;
+   STOQ(NoGC,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoGC"); MKNODE(n1,name,n); n = n1;
+   STOQ(NoCriB,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoCriB"); MKNODE(n1,name,n); n = n1;
+   STOQ(NoSugar,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NoSugar"); MKNODE(n1,name,n); n = n1;
+   if ( Demand )
+     MKSTR(path,Demand);
+   else
+     path = 0;
+   MKNODE(n1,path,n); n = n1; MKSTR(name,"Demand"); MKNODE(n1,name,n); n = n1;
+   MKLIST(*list,n);
+ }
- void dp_save(index,p,prefix)
+ #define DELIM '/'
- int index;
- Obj p;
+ void dp_save(int index,Obj p,char *prefix)
- char *prefix;
  {
-         FILE *fp;
+   FILE *fp;
-         char path[BUFSIZ];
+   char path[BUFSIZ];
-         if ( prefix )
+   if ( prefix )
-                 sprintf(path,"%s%c%s%d",Demand,DELIM,prefix,index);
+     sprintf(path,"%s%c%s%d",Demand,DELIM,prefix,index);
-         else
+   else
-                 sprintf(path,"%s%c%d",Demand,DELIM,index);
+     sprintf(path,"%s%c%d",Demand,DELIM,index);
- #if defined(VISUAL) || defined(THINK_C)
+   if ( !(fp = fopen(path,"wb") ) )
-         if ( !(fp = fopen(path,"wb") ) )
+     error("dp_save : cannot open a file");
- #else
+   savevl(fp,VC); saveobj(fp,p); fclose(fp);
-         if ( !(fp = fopen(path,"w") ) )
- #endif
-                 error("dp_save : cannot open a file");
-         savevl(fp,VC); saveobj(fp,p); fclose(fp);
  }
- void dp_load(index,p)
+ void dp_load(int index,DP *p)
- int index;
- DP *p;
  {
-         FILE *fp;
+   FILE *fp;
-         char path[BUFSIZ];
+   char path[BUFSIZ];
-         if ( !Demand || ps[index] )
+   if ( !Demand || ps[index] )
-                 *p = ps[index];
+     *p = ps[index];
-         else {
+   else {
-                 sprintf(path,"%s%c%d",Demand,DELIM,index);
+     sprintf(path,"%s%c%d",Demand,DELIM,index);
- #if defined(VISUAL) || defined(THINK_C)
+     if ( !(fp = fopen(path,"rb") ) )
-                 if ( !(fp = fopen(path,"rb") ) )
+       error("dp_load : cannot open a file");
- #else
+     if ( PCoeffs )
-                 if ( !(fp = fopen(path,"r") ) )
+       loadvl(fp);
- #endif
+     else
-                         error("dp_load : cannot open a file");
+       skipvl(fp);
-                 skipvl(fp); loadobj(fp,(Obj *)p); fclose(fp);
+     loadobj(fp,(Obj *)p); fclose(fp);
-         }
+   }
  }
- int dp_load_t(index,p)
+ int dp_load_t(int index,DP *p)
- int index;
- DP *p;
  {
-         FILE *fp;
+   FILE *fp;
-         char path[BUFSIZ];
+   char path[BUFSIZ];
-         sprintf(path,"%s%c%d",Demand,DELIM,index);
+   sprintf(path,"%s%c%d",Demand,DELIM,index);
- #if defined(VISUAL) || defined(THINK_C)
+   if ( !(fp = fopen(path,"rb") ) )
-         if ( !(fp = fopen(path,"rb") ) )
+     return 0;
- #else
+   else {
-         if ( !(fp = fopen(path,"r") ) )
+     if ( PCoeffs )
- #endif
+       loadvl(fp);
-                 return 0;
+     else
-         else {
+       skipvl(fp);
-                 skipvl(fp); loadobj(fp,(Obj *)p); fclose(fp); return 1;
+     loadobj(fp,(Obj *)p); fclose(fp); return 1;
-         }
+   }
  }
  void init_stat() {
-         init_eg(&eg_up); init_eg(&eg_sp); init_eg(&eg_spm);
+   init_eg(&eg_nf); init_eg(&eg_nfm); init_eg(&eg_znfm);
-         init_eg(&eg_nf); init_eg(&eg_nfm); init_eg(&eg_znfm);
+   init_eg(&eg_pz); init_eg(&eg_np);
-         init_eg(&eg_pz); init_eg(&eg_np); init_eg(&eg_mp);
+   init_eg(&eg_ra); init_eg(&eg_mc); init_eg(&eg_gc);
-         init_eg(&eg_ra); init_eg(&eg_mc); init_eg(&eg_gc);
+   ZR = NZR = TP = NMP = N_BP = NFP = NDP = 0;
-         ZR = NZR = TP = NBP = NMP = NFP = NDP = 0;
  }
  void print_stat() {
-         if ( !Print && !Stat )
+   if ( !DP_Print && !Stat )
-                 return;
+     return;
-         print_eg("UP",&eg_up); print_eg("SP",&eg_sp); print_eg("SPM",&eg_spm);
+   print_eg("NF",&eg_nf); print_eg("NFM",&eg_nfm); print_eg("ZNFM",&eg_znfm);
-         print_eg("NF",&eg_nf); print_eg("NFM",&eg_nfm); print_eg("ZNFM",&eg_znfm);
+   print_eg("PZ",&eg_pz); print_eg("NP",&eg_np);
-         print_eg("PZ",&eg_pz); print_eg("NP",&eg_np); print_eg("MP",&eg_mp);
+   print_eg("RA",&eg_ra); print_eg("MC",&eg_mc); print_eg("GC",&eg_gc);
-         print_eg("RA",&eg_ra); print_eg("MC",&eg_mc); print_eg("GC",&eg_gc);
+   fprintf(asir_out,"T=%d,B=%d M=%d F=%d D=%d ZR=%d NZR=%d\n",TP,N_BP,NMP,NFP,NDP,ZR,NZR);
-         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);
  }
  /*
-  * Old codes
+  * dp_nf used in gb()
+  *
   */
- #if 0
+ double pz_t_e, pz_t_d, pz_t_d1, pz_t_c, im_t_s, im_t_r;
- void _dp_nf_ptozp(b,g,ps,full,multiple,rp)
- NODE b;
+ extern int GenTrace;
- DP g;
+ extern NODE TraceList;
- DP *ps;
+ extern int mpi_mag;
- int full,multiple;
- DP *rp;
+ void dp_mulc_d(DP p,P c,DP *r)
  {
-         P dmy;
+   if ( Dist && BDY(Dist)
-         DP u,p,d,s,t,dmy1;
+     && HMAG(p) > mpi_mag
-         NODE l;
+     && p_mag((P)c) > mpi_mag ) {
-         MP m,mr;
+     if ( DP_NFStat ) fprintf(asir_out,"~");
-         int i,n;
+     dp_imul_d(p,(Q)c,r);
-         int hmag,denom;
+   } else {
-         int sugar,psugar;
+     if ( DP_NFStat ) fprintf(asir_out,"_");
-         NODE dist;
+     muldc(CO,p,(Obj)c,r);
-         int ndist;
+   }
-         int kara_bit;
+ }
-         extern int kara_mag;
-         if ( !g ) {
+ void _dp_nf(NODE b,DP g,DP *ps,int full,DP *rp)
-                 *rp = 0; return;
+ {
-         }
+   DP u,p,d,s,t,mult;
-         denom = Denominator?Denominator:1;
+   P coef;
-         hmag = multiple*HMAG(g)/denom;
+   NODE l;
-         kara_bit = kara_mag*27; /* XXX */
+   MP m,mr;
-         if ( Dist ) {
+   int sugar,psugar;
-                 dist = BDY(Dist);
-                 ndist = length(dist);
+   if ( !g ) {
-         }
+     *rp = 0; return;
-         sugar = g->sugar;
+   }
-         for ( d = 0; g; ) {
+   sugar = g->sugar;
-                 for ( u = 0, l = b; l; l = NEXT(l) ) {
+   for ( d = 0; g; ) {
-                         if ( dl_redble(BDY(g)->dl,psh[(int)BDY(l)]) ) {
+     for ( u = 0, l = b; l; l = NEXT(l) ) {
-                                 dp_load((int)BDY(l),&p);
+       if ( dl_redble(BDY(g)->dl,psh[(int)BDY(l)]) ) {
-                                 dp_red(d,g,p,&t,&u,&dmy,&dmy1);
+         dp_load((int)BDY(l),&p);
-                                 psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar;
+         /* t+u = coef*(d+g) - mult*p (t = coef*d) */
-                                 sugar = MAX(sugar,psugar);
+         dp_red(d,g,p,&t,&u,&coef,&mult);
-                                 if ( !u ) {
+         psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar;
-                                         if ( d )
+         sugar = MAX(sugar,psugar);
-                                                 d->sugar = sugar;
+         if ( GenTrace ) {
-                                         *rp = d; return;
+           LIST hist;
-                                 }
+           Q cq;
-                                 d = t;
+           NODE node,node0;
-                                 break;
-                         }
+           STOQ((int)BDY(l),cq);
-                 }
+           node0 = mknode(4,coef,cq,mult,ONE);
-                 if ( u ) {
+           MKLIST(hist,node0);
-                         g = u;
+           MKNODE(node,hist,TraceList); TraceList = node;
-                         if ( d ) {
+         }
-                                 if ( HMAG(d) > hmag ) {
+         if ( !u ) {
-                                         if ( Dist && HMAG(g) > kara_bit )
+           if ( d )
-                                                 dp_ptozp2_d(dist,ndist,d,g,&t,&u);
+             d->sugar = sugar;
-                                         else
+           *rp = d; return;
-                                                 dp_ptozp2(d,g,&t,&u);
+         }
-                                         d = t; g = u;
+         d = t;
-                                         hmag = multiple*HMAG(d)/denom;
+         break;
-                                 }
+       }
-                         } else {
+     }
-                                 if ( HMAG(g) > hmag ) {
+     if ( u )
- #if INET
+       g = u;
-                                         if ( Dist && HMAG(g) > kara_bit ) {
+     else if ( !full ) {
-                                                 dp_ptozp_d(dist,ndist,g,&t);
+       if ( g ) {
-                                         } else
+         MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t;
- #endif
+       }
-                                                 dp_ptozp(g,&t);
+       *rp = g; return;
-                                         g = t;
+     } else {
-                                         hmag = multiple*HMAG(g)/denom;
+       m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c;
-                                 }
+       NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td;
-                         }
+       addd(CO,d,t,&s); d = s;
-                 }
+       dp_rest(g,&t); g = t;
-                 else if ( !full ) {
+     }
-                         if ( g ) {
+   }
-                                 MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t;
+   if ( d )
-                         }
+     d->sugar = sugar;
-                         *rp = g; return;
+   *rp = d;
-                 } else {
-                         m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c;
-                         NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td;
-                         addd(CO,d,t,&s); d = s;
-                         dp_rest(g,&t); g = t;
-                 }
-         }
-         if ( d )
-                 d->sugar = sugar;
-         *rp = d;
  }
- int criterion_2(dp1,dp2)
+ void _dp_nf_z(NODE b,DP g,DP *ps,int full,int multiple,DP *r)
  {
-         DP g1,g2,g,s1,s2;
+   DP u,dp,rp,t,t1,red,shift;
+   Q dc,rc,dcq,rcq,cont,hr,hred,cr,cred,mcred,c,gcd,cq;
+   NODE l;
+   int hmag,denom;
+   int sugar,psugar;
+   STRING imul;
+   double t_0,tt,t_p,t_m,t_g,t_a;
+   LIST hist;
+   NODE node;
+   Q rcred,mrcred;
-         monomial_gcd(ps[dp1],&g1); monomial_gcd(ps[dp2],&g2);
+   if ( !g ) {
-         dp_gcd(g1,g2,&g);
+     *r = 0; return;
-         dp_subd(ps[dp1],g,&s1); dp_subd(ps[dp2],g,&s2);
+   }
-         return _criterion_2(s1,s2);
+   pz_t_e = pz_t_d = pz_t_d1 = pz_t_c = 0;
+   t_p = t_m = t_g = t_a = 0;
+   denom = Denominator?Denominator:1;
+   hmag = multiple*HMAG(g)/denom;
+   sugar = g->sugar;
+   dc = 0; dp = 0; rc = ONE; rp = g;
+   MKSTR(imul,"dp_imul_index");
+   /* g = dc*dp+rc*rp */
+   for ( ; rp; ) {
+     for ( u = 0, l = b; l; l = NEXT(l) ) {
+       if ( dl_redble(BDY(rp)->dl,psh[(int)BDY(l)]) ) {
+         t_0 = get_rtime();
+         dp_load((int)BDY(l),&red);
+         hr = (Q)BDY(rp)->c; hred = (Q)BDY(red)->c;
+         igcd_cofactor((Q)BDY(rp)->c,(Q)BDY(red)->c,&gcd,&cred,&cr);
+         tt = get_rtime(); t_p += tt-t_0;
+         dp_subd(rp,red,&shift);
+         dp_mulc_d(rp,(P)cr,&t);
+         chsgnp((P)cred,(P *)&mcred);
+         dp_mulc_d(red,(P)mcred,&t1);
+         muld(CO,shift,t1,&t1);
+         addd(CO,t,t1,&u);
+         t_m += get_rtime()-tt;
+         psugar = (BDY(rp)->dl->td - BDY(red)->dl->td) + red->sugar;
+         sugar = MAX(sugar,psugar);
+         if ( GenTrace ) {
+           /* u = cr*rp + (-cred)*shift*red */
+           STOQ((int)BDY(l),cq);
+           node = mknode(4,cr,cq,NULLP,NULLP);
+           mulq(cred,rc,&rcred);
+           chsgnnum((Num)rcred,(Num *)&mrcred);
+           muldc(CO,shift,(Obj)mrcred,(DP *)&ARG2(node));
+           MKLIST(hist,node);
+         }
+         if ( !u ) {
+           if ( dp )
+             dp->sugar = sugar;
+           *r = dp;
+           if ( GenTrace ) {
+             ARG3(BDY(hist)) = ONE;
+             MKNODE(node,hist,TraceList); TraceList = node;
+           }
+           goto final;
+         }
+         break;
+       }
+     }
+     if ( u ) {
+       if ( multiple && HMAG(u) > hmag ) {
+         t_0 = get_rtime();
+         dp_ptozp_d(u,&rp);
+         tt = get_rtime(); t_g += tt-t_0;
+         divsq((Q)BDY(u)->c,(Q)BDY(rp)->c,&cont);
+         if ( !dp_fcoeffs && DP_NFStat ) {
+           fprintf(asir_out,
+             "(%d)",p_mag((P)cont)*100/p_mag((P)BDY(u)->c));
+           fflush(asir_out);
+         }
+         mulq(cr,dc,&dcq); mulq(cont,rc,&rcq);
+         igcd_cofactor(dcq,rcq,&gcd,&dc,&rc);
+         t_a = get_rtime()-tt;
+         hmag = multiple*HMAG(rp)/denom;
+         if ( GenTrace ) {
+           ARG3(BDY(hist)) = (pointer)gcd;
+           MKNODE(node,hist,TraceList); TraceList = node;
+         }
+       } else {
+         rp = u;
+         t_0 = get_rtime();
+         mulq(cr,dc,&dc);
+         t_a += get_rtime()-t_0;
+         if ( GenTrace ) {
+           ARG3(BDY(hist)) = (pointer)ONE;
+           MKNODE(node,hist,TraceList); TraceList = node;
+         }
+       }
+     } else if ( !full ) {
+       if ( rp ) {
+         MKDP(rp->nv,BDY(rp),t); t->sugar = sugar; rp = t;
+       }
+       *r = rp;
+       goto final;
+     } else {
+       t_0 = get_rtime();
+       mulq((Q)BDY(rp)->c,rc,&c);
+       igcd_cofactor(dc,c,&dc,&dcq,&cq);
+       muldc(CO,dp,(Obj)dcq,&t);
+       dp_hm(rp,&t1); BDY(t1)->c = (Obj)cq;  addd(CO,t,t1,&dp);
+       dp_rest(rp,&rp);
+       t_a += get_rtime()-t_0;
+     }
+   }
+   if ( GenTrace ) {
+     mulq(ARG3(BDY((LIST)BDY(TraceList))),dc,&cq);
+     ARG3(BDY((LIST)BDY(TraceList))) = (pointer)cq;
+   }
+   if ( dp )
+     dp->sugar = sugar;
+   *r = dp;
+ final:
+   if ( DP_NFStat )
+     fprintf(asir_out,
+       "(%.3g %.3g %.3g %.3g %.3g %.3g %.3g %.3g)",
+       t_p,t_m,t_g,t_a,
+       pz_t_e, pz_t_d, pz_t_d1, pz_t_c);
  }
- int _criterion_2( dp1, dp2 )
+ void imulv();
- DP dp1, dp2;
+ void dp_imul_d(DP p,Q q,DP *rp)
  {
-         register int i, *d1, *d2;
+   int nsep,ndist,i,j,k,l,n;
+   double t0,t1,t2;
+   Q *s;
+   pointer *b;
+   VECT c,cs,ri;
+   VECT *r;
+   MP m;
+   NODE tn,dist,n0;
+   Obj obj;
+   STRING imul;
+   extern LIST Dist;
-         d1 = BDY(dp1)->dl->d; d2 = BDY(dp2)->dl->d;
+   if ( !p || !q ) {
-         for ( i = CNVars; --i >= 0; d1++, d2++ )
+     *rp = 0; return;
-                 if ( (*d1 <= *d2 ? *d1 : *d2) > 0  ) return 0;
+   }
-         return 1;
+   dist = BDY(Dist);
+   for ( tn = dist, ndist = 0; tn; tn = NEXT(tn), ndist++ );
+   nsep = ndist + 1;
+   for ( m = BDY(p), n = 0; m; m = NEXT(m), n++ );
+   if ( n <= nsep ) {
+     muldc(CO,p,(Obj)q,rp); return;
+   }
+   MKSTR(imul,"imulv");
+   t0 = get_rtime();
+   dp_dtov(p,&c);
+   sepvect(c,nsep,&cs);
+   r = (VECT *)CALLOC(nsep,sizeof(VECT *));
+   for ( i = 0, tn = dist, b = BDY(cs); i < ndist; i++, tn = NEXT(tn) ) {
+     n0 = mknode(4,BDY(tn),imul,b[i],q);
+     Pox_rpc(n0,&obj);
+   }
+   t1 = get_rtime();
+   im_t_s += t1 - t0;
+   imulv(b[i],q,&r[i]);
+   t1 = get_rtime();
+   for ( i = 0, tn = dist; i < ndist; i++, tn = NEXT(tn) ) {
+     MKNODE(n0,BDY(tn),0);
+     Pox_pop_local(n0,&obj); r[i] = (VECT)obj;
+     if ( OID(r[i]) == O_ERR ) {
+       printexpr(CO,(Obj)r[i]);
+       error("dp_imul_d : aborted");
+     }
+   }
+   t2 = get_rtime();
+   im_t_r += t2 - t1;
+   s = (Q *)CALLOC(n,sizeof(Q));
+   for ( i = j = 0; i < nsep; i++ ) {
+     for ( k = 0, ri = r[i], l = ri->len; k < l; k++, j++ ) {
+       s[j] = (Q)BDY(ri)[k];
+     }
+   }
+   dp_vtod(s,p,rp);
  }
- void dp_gcd(p1,p2,rp)
+ void imulv(VECT w,Q c,VECT *rp)
- DP p1,p2;
- DP *rp;
  {
-         int i,n,td;
+   int n,i;
-         DL d1,d2,d;
+   VECT r;
-         MP m;
-         DP s;
-         n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl;
+   n = w->len;
-         NEWDL(d,n);
+   MKVECT(r,n); *rp = r;
-         for ( i = 0, td = 0; i < n; i++ ) {
+   for ( i = 0; i < n; i++ )
-                 d->d[i] = MIN(d1->d[i],d2->d[i]);
+     mulq((Q)BDY(w)[i],(Q)c,(Q *)&BDY(r)[i]);
-                 td += d->d[i];
-         }
-         d->td = td;
-         NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0; MKDP(n,m,s); s->sugar = d->td;
-         *rp = s;
  }
- void monomial_gcd(p,rp)
+ void dptoca(DP p,unsigned int **rp)
- DP p;
- DP *rp;
  {
-         int n,i,td;
+   int i;
-         DL d,d1;
+   MP m;
-         MP m;
+   unsigned int *r;
-         DP s;
-         n = p->nv; m = BDY(p); d = m->dl;
+   if ( !p )
-         NEWDL(d1,n);
+     *rp = 0;
-         for ( i = 0; i < n; i++ )
+   else {
-                 d1->d[i] = d->d[i];
+     for ( m = BDY(p), i = 0; m; m = NEXT(m), i++ );
-         for ( m = NEXT(m); m; m = NEXT(m) ) {
+     *rp = r = (unsigned int *)MALLOC_ATOMIC(i*sizeof(unsigned int));
-                 d = m->dl;
+     for ( m = BDY(p), i = 0; m; m = NEXT(m), i++ )
-                 for ( i = 0; i < n; i++ )
+       r[i] = ITOS(C(m));
-                         d1->d[i] = MIN(d1->d[i],d->d[i]);
+   }
-         }
-         for ( i = 0, td = 0; i < n; i++ )
-                 td += d1->d[i];
-         NEWMP(m); m->dl = d1; m->c = (P)ONE; NEXT(m) = 0; MKDP(n,m,s); s->sugar = d->td;
-         *rp = s;
  }
- #endif

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