=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/dp-supp.c,v retrieving revision 1.13 retrieving revision 1.18 diff -u -p -r1.13 -r1.18 --- OpenXM_contrib2/asir2000/builtin/dp-supp.c 2001/09/04 08:48:18 1.13 +++ OpenXM_contrib2/asir2000/builtin/dp-supp.c 2001/09/17 10:32:40 1.18 @@ -45,10 +45,11 @@ * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. * - * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp-supp.c,v 1.12 2001/02/21 07:10:17 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp-supp.c,v 1.17 2001/09/17 02:58:27 noro Exp $ */ #include "ca.h" #include "base.h" +#include "inline.h" #include "parse.h" #include "ox.h" @@ -569,6 +570,61 @@ DP *rp; } } +void _dp_sp_dup(p1,p2,rp) +DP p1,p2; +DP *rp; +{ + int i,n,td; + int *w; + DL d1,d2,d; + MP m; + DP t,s1,s2,u; + Q c,c1,c2; + N gn,tn; + + n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; + w = (int *)ALLOCA(n*sizeof(int)); + for ( i = 0, td = 0; i < n; i++ ) { + w[i] = MAX(d1->d[i],d2->d[i]); td += w[i]; + } + + _NEWDL(d,n); d->td = td - d1->td; + for ( i = 0; i < n; i++ ) + d->d[i] = w[i] - d1->d[i]; + c1 = (Q)BDY(p1)->c; c2 = (Q)BDY(p2)->c; + if ( INT(c1) && INT(c2) ) { + gcdn(NM(c1),NM(c2),&gn); + if ( !UNIN(gn) ) { + divsn(NM(c1),gn,&tn); NTOQ(tn,SGN(c1),c); c1 = c; + divsn(NM(c2),gn,&tn); NTOQ(tn,SGN(c2),c); c2 = c; + } + } + + _NEWMP(m); m->dl = d; m->c = (P)c2; NEXT(m) = 0; + _MKDP(n,m,s1); s1->sugar = d->td; _muld_dup(CO,s1,p1,&t); _free_dp(s1); + + _NEWDL(d,n); d->td = td - d2->td; + for ( i = 0; i < n; i++ ) + d->d[i] = w[i] - d2->d[i]; + _NEWMP(m); m->dl = d; chsgnp((P)c1,&m->c); NEXT(m) = 0; + _MKDP(n,m,s2); s2->sugar = d->td; _muld_dup(CO,s2,p2,&u); _free_dp(s2); + + _addd_destructive(CO,t,u,rp); + if ( GenTrace ) { + LIST hist; + NODE node; + + node = mknode(4,ONE,0,s1,ONE); + MKLIST(hist,node); + MKNODE(TraceList,hist,0); + + node = mknode(4,ONE,0,0,ONE); + chsgnd(s2,(DP *)&ARG2(node)); + MKLIST(hist,node); + MKNODE(node,hist,TraceList); TraceList = node; + } +} + void dp_sp_mod(p1,p2,mod,rp) DP p1,p2; int mod; @@ -585,12 +641,12 @@ DP *rp; for ( i = 0, td = 0; i < n; i++ ) { w[i] = MAX(d1->d[i],d2->d[i]); td += w[i]; } - NEWDL(d,n); d->td = td - d1->td; + NEWDL_NOINIT(d,n); d->td = td - d1->td; for ( i = 0; i < n; i++ ) d->d[i] = w[i] - d1->d[i]; NEWMP(m); m->dl = d; m->c = (P)BDY(p2)->c; NEXT(m) = 0; MKDP(n,m,s); s->sugar = d->td; mulmd(CO,mod,p1,s,&t); - NEWDL(d,n); d->td = td - d2->td; + NEWDL_NOINIT(d,n); d->td = td - d2->td; for ( i = 0; i < n; i++ ) d->d[i] = w[i] - d2->d[i]; NEWMP(m); m->dl = d; m->c = (P)BDY(p1)->c; NEXT(m) = 0; @@ -771,17 +827,28 @@ DP *rp; DL d1,d2,d; MP m; DP t,s; - int c,c1; -struct oEGT t0,t1; + int c,c1,c2; + struct oEGT t0,t1; + extern int do_weyl; n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl; _NEWDL(d,n); d->td = d1->td - d2->td; for ( i = 0; i < n; i++ ) d->d[i] = d1->d[i]-d2->d[i]; - c = invm(ITOS(BDY(p2)->c),mod); c1 = dmar(c,ITOS(BDY(p1)->c),0,mod); + c = invm(ITOS(BDY(p2)->c),mod); + c2 = ITOS(BDY(p1)->c); + DMAR(c,c2,0,mod,c1); _NEWMP(m); m->dl = d; m->c = STOI(mod-c1); NEXT(m) = 0; +#if 0 _MKDP(n,m,s); s->sugar = d->td; _mulmd_dup(mod,s,p2,&t); _free_dp(s); +#else + if ( do_weyl ) { + _weyl_mulmdm_dup(mod,p2,m,&t); _FREEMP(m); + } else { + _mulmdm_dup(mod,p2,m,&t); _FREEMP(m); + } +#endif /* get_eg(&t0); */ _addmd_destructive(mod,p1,t,rp); /* get_eg(&t1); add_eg(&eg_red_mod,&t0,&t1); */ @@ -1635,3 +1702,42 @@ DP p; } } +int dp_homogeneous(p) +DP p; +{ + MP m; + int d; + + if ( !p ) + return 1; + else { + m = BDY(p); + d = m->dl->td; + m = NEXT(m); + for ( ; m; m = NEXT(m) ) { + if ( m->dl->td != d ) + return 0; + } + return 1; + } +} + +_print_mp(nv,m) +int nv; +MP m; +{ + int i; + + if ( !m ) + return; + for ( ; m; m = NEXT(m) ) { + fprintf(stderr,"%d<",ITOS(C(m))); + for ( i = 0; i < nv; i++ ) { + fprintf(stderr,"%d",m->dl->d[i]); + if ( i != nv-1 ) + fprintf(stderr," "); + } + fprintf(stderr,">",C(m)); + } + fprintf(stderr,"\n"); +}