OpenXM_contrib2/asir2000/engine/nd.c - diff

Return to nd.c CVS log

Up to [local] / OpenXM_contrib2 / asir2000 / engine

Diff for /OpenXM_contrib2/asir2000/engine/nd.c between version 1.55 and 1.60

version 1.55, 2003/09/03 07:33:35

version 1.60, 2003/09/06 01:33:26

Line 1

/* $OpenXM: OpenXM_contrib2/asir2000/engine/nd.c,v 1.54 2003/08/31 07:42:23 noro Exp $ */

/* $OpenXM: OpenXM_contrib2/asir2000/engine/nd.c,v 1.59 2003/09/05 13:20:14 noro Exp $ */

#include "ca.h"

#include "inline.h"

Line 121 static int nmv_adv;

static int nd_dcomp;

extern int Top,Reverse,dp_nelim,do_weyl;

extern int *current_weyl_weight_vector;

/* fundamental macros */

#define TD(d) (d[0])

Line 135 extern int Top,Reverse,dp_nelim,do_weyl;

Line 136 extern int Top,Reverse,dp_nelim,do_weyl;

#define LEN(a) ((a)->len)

#define LCM(a) ((a)->lcm)

#define GET_EXP(d,a) (((d)[nd_epos[a].i]>>nd_epos[a].s)&nd_mask0)

#define GET_EXP_MASK(d,a,m) ((((d)[nd_epos[a].i]&(m)[nd_epos[a].i])>>nd_epos[a].s)&nd_mask0)

#define PUT_EXP(r,a,e) ((r)[nd_epos[a].i] |= ((e)<<nd_epos[a].s))

#define XOR_EXP(r,a,e) ((r)[nd_epos[a].i] ^= ((e)<<nd_epos[a].s))

Line 185 if(!(r)){NEWND_pairs(r);(c)=(r);}else{NEWND_pairs(NEXT

Line 187 if(!(r)){NEWND_pairs(r);(c)=(r);}else{NEWND_pairs(NEXT

/* macro for increasing pointer to NMV */

#define NMV_ADV(m) (m = (NMV)(((char *)m)+nmv_adv))

#define NMV_PREV(m) (m = (NMV)(((char *)m)-nmv_adv))

/* external functions */

void GC_gcollect();

Line 225 NODE nd_gb_trace(int m);

Line 228 NODE nd_gb_trace(int m);

/* ndl functions */

int ndl_weight(unsigned int *d);

int ndl_weight_mask(unsigned int *d,int i);

void ndl_set_blockweight(unsigned int *d);

void ndl_dehomogenize(unsigned int *p);

void ndl_reconstruct(int obpe,EPOS oepos,unsigned int *d,unsigned int *r);

INLINE int ndl_reducible(unsigned int *d1,unsigned int *d2);

Line 272 void nd_reconstruct_direct(int mod,NDV *ps,int len);

Line 276 void nd_reconstruct_direct(int mod,NDV *ps,int len);

void nd_setup(int mod,int trace,NODE f);

void nd_setup_parameters();

BlockMask nd_create_blockmask(struct order_spec *ord);

EPOS nd_create_epos(struct order_spec *ord);

int nd_get_exporigin(struct order_spec *ord);

/* ND functions */

Line 282 ND nd_remove_head(ND p);

Line 287 ND nd_remove_head(ND p);

int nd_length(ND p);

void nd_append_red(unsigned int *d,int i);

unsigned int *ndv_compute_bound(NDV p);

unsigned int *dp_compute_bound(DP p);

ND nd_copy(ND p);

ND nd_add(int mod,ND p1,ND p2);

ND nd_add_q(ND p1,ND p2);

Line 291 INLINE int nd_length(ND p);

Line 295 INLINE int nd_length(ND p);

/* NDV functions */

ND weyl_ndv_mul_nm(int mod,NM m0,NDV p);

void weyl_mul_nm_nmv(int n,int mod,NM m0,NMV m1,NM *tab,int tlen);

void weyl_mul_nm_nmv_q(int n,NM m0,NMV m1,NM *tab,int tlen);

void ndv_mul_c(int mod,NDV p,int mul);

void ndv_mul_c_q(NDV p,Q mul);

void ndv_realloc(NDV p,int obpe,int oadv,EPOS oepos);

Line 540 void ndl_lcm(unsigned int *d1,unsigned *d2,unsigned in

Line 543 void ndl_lcm(unsigned int *d1,unsigned *d2,unsigned in

}

void ndl_set_blockweight(unsigned int *d) {

int l,j;

if ( nd_blockmask ) {

l = nd_blockmask->n;

for ( j = 0; j < l; j++ )

d[j+1] = ndl_weight_mask(d,j);

}

int ndl_weight(unsigned int *d)

{

unsigned int t,u;

int i,j;

for ( t = 0, i = nd_exporigin; i < nd_wpd; i++ ) {

if ( current_dl_weight_vector )

u = d[i];

for ( i = 0, t = 0; i < nd_nvar; i++ ) {

for ( j = 0; j < nd_epw; j++, u>>=nd_bpe )

u = GET_EXP(d,i);

t += (u&nd_mask0);

t += MUL_WEIGHT(u,i);

}

else

for ( t = 0, i = nd_exporigin; i < nd_wpd; i++ ) {

u = d[i];

for ( j = 0; j < nd_epw; j++, u>>=nd_bpe )

t += (u&nd_mask0);

}

return t;

}

Line 560 int ndl_weight_mask(unsigned int *d,int index)

Line 579 int ndl_weight_mask(unsigned int *d,int index)

int i,j;

mask = nd_blockmask->mask[index];

for ( t = 0, i = nd_exporigin; i < nd_wpd; i++ ) {

if ( current_dl_weight_vector )

u = d[i]&mask[i];

for ( i = 0, t = 0; i < nd_nvar; i++ ) {

for ( j = 0; j < nd_epw; j++, u>>=nd_bpe )

u = GET_EXP_MASK(d,i,mask);

t += (u&nd_mask0);

t += MUL_WEIGHT(u,i);

}

else

for ( t = 0, i = nd_exporigin; i < nd_wpd; i++ ) {

u = d[i]&mask[i];

for ( j = 0; j < nd_epw; j++, u>>=nd_bpe )

t += (u&nd_mask0);

}

return t;

}

Line 610 int ndl_block_compare(unsigned int *d1,unsigned int *d

Line 635 int ndl_block_compare(unsigned int *d1,unsigned int *d

return 0;

}

/* TDH -> WW -> TD-> RL */

int ndl_ww_lex_compare(unsigned int *d1,unsigned int *d2)

{

int i,m,e1,e2;

if ( TD(d1) > TD(d2) ) return 1;

else if ( TD(d1) < TD(d2) ) return -1;

m = nd_nvar>>1;

for ( i = 0, e1 = e2 = 0; i < m; i++ ) {

e1 += current_weyl_weight_vector[i]*(GET_EXP(d1,m+i)-GET_EXP(d1,i));

e2 += current_weyl_weight_vector[i]*(GET_EXP(d2,m+i)-GET_EXP(d2,i));

}

if ( e1 > e2 ) return 1;

else if ( e1 < e2 ) return -1;

return ndl_lex_compare(d1,d2);

}

INLINE int ndl_equal(unsigned int *d1,unsigned int *d2)

{

int i;

Line 1764 ND_pairs crit_B( ND_pairs d, int s )

Line 1807 ND_pairs crit_B( ND_pairs d, int s )

return head;

}

/* XXX : check is necessary */

ND_pairs crit_M( ND_pairs d1 )

{

ND_pairs e,d2,d3,dd,p;

Line 1960 void nd_setup(int mod,int trace,NODE f)

Line 2001 void nd_setup(int mod,int trace,NODE f)

unsigned int *d;

RHist r;

NDV a;

MP t;

nd_found = 0; nd_notfirst = 0; nd_create = 0;

Line 1968 void nd_setup(int mod,int trace,NODE f)

Line 2010 void nd_setup(int mod,int trace,NODE f)

nd_ps_trace = (NDV *)MALLOC(nd_pslen*sizeof(NDV));

nd_psh = (RHist *)MALLOC(nd_pslen*sizeof(RHist));

nd_bound = (unsigned int **)MALLOC(nd_pslen*sizeof(unsigned int *));

for ( max = 0, i = 0, s = f; i < nd_psn; i++, s = NEXT(s) ) {

nd_bound[i] = d = dp_compute_bound((DP)BDY(s));

for ( j = 0; j < nd_nvar; j++ )

max = MAX(d[j],max);

}

if ( !nd_red )

nd_red = (RHist *)MALLOC(REDTAB_LEN*sizeof(RHist));

bzero(nd_red,REDTAB_LEN*sizeof(RHist));

for ( max = 0, s = f; s; s = NEXT(s) )

for ( t = BDY((DP)BDY(s)); t; t = NEXT(t) ) {

d = t->dl->d;

for ( j = 0; j < nd_nvar; j++ ) max = MAX(d[j],max);

}

if ( max < 2 ) nd_bpe = 2;

else if ( max < 4 ) nd_bpe = 4;

else if ( max < 64 ) nd_bpe = 6;

Line 1990 void nd_setup(int mod,int trace,NODE f)

Line 2034 void nd_setup(int mod,int trace,NODE f)

NEWRHist(r);

a = dptondv(mod,(DP)BDY(f)); ndv_removecont(mod,a);

SG(r) = HTD(a); ndl_copy(HDL(a),DL(r));

nd_ps[i] = a;

if ( trace ) {

a = dptondv(0,(DP)BDY(f)); ndv_removecont(0,a);

nd_ps_trace[i] = a;

}

nd_bound[i] = ndv_compute_bound(a);

nd_psh[i] = r;

}

Line 2141 void nd_gr_trace(LIST f,LIST v,int trace,int homo,stru

Line 2185 void nd_gr_trace(LIST f,LIST v,int trace,int homo,stru

void dltondl(int n,DL dl,unsigned int *r)

{

unsigned int *d;

int i,j,l,s,ord_l,ord_o;

int i,j,l,s,ord_l;

struct order_pair *op;

d = dl->d;

Line 2150 void dltondl(int n,DL dl,unsigned int *r)

Line 2194 void dltondl(int n,DL dl,unsigned int *r)

l = nd_blockmask->n;

op = nd_blockmask->order_pair;

for ( j = 0, s = 0; j < l; j++ ) {

ord_o = op[j].order;

ord_l = op[j].length;

if ( !ord_o )

for ( i = 0; i < ord_l; i++, s++ ) PUT_EXP(r,s,d[s]);

for ( i = 0; i < ord_l; i++ )

PUT_EXP(r,s+ord_l-i-1,d[s+i]);

else

for ( i = 0; i < ord_l; i++ )

PUT_EXP(r,s+i,d[s+i]);

s += ord_l;

}

TD(r) = ndl_weight(r);

for ( j = 0; j < l; j++ )

r[j+1] = ndl_weight_mask(r,j);

} else {

if ( nd_isrlex )

for ( i = 0; i < n; i++ ) PUT_EXP(r,i,d[i]);

for ( i = 0; i < n; i++ ) PUT_EXP(r,n-1-i,d[i]);

else

for ( i = 0; i < n; i++ ) PUT_EXP(r,i,d[i]);

TD(r) = ndl_weight(r);

}

Line 2176 DL ndltodl(int n,unsigned int *ndl)

Line 2210 DL ndltodl(int n,unsigned int *ndl)

{

DL dl;

int *d;

int i,j,l,s,ord_l,ord_o;

int i,j,l,s,ord_l;

struct order_pair *op;

NEWDL(dl,n);

Line 2186 DL ndltodl(int n,unsigned int *ndl)

Line 2220 DL ndltodl(int n,unsigned int *ndl)

l = nd_blockmask->n;

op = nd_blockmask->order_pair;

for ( j = 0, s = 0; j < l; j++ ) {

ord_o = op[j].order;

ord_l = op[j].length;

if ( !ord_o )

for ( i = 0; i < ord_l; i++, s++ ) d[s] = GET_EXP(ndl,s);

for ( i = 0; i < ord_l; i++ )

d[s+i] = GET_EXP(ndl,s+ord_l-i-1);

else

for ( i = 0; i < ord_l; i++ )

d[s+i] = GET_EXP(ndl,s+i);

s += ord_l;

}

} else {

if ( nd_isrlex )

for ( i = 0; i < n; i++ ) d[i] = GET_EXP(ndl,i);

for ( i = 0; i < n; i++ )

d[i] = GET_EXP(ndl,n-1-i);

else

for ( i = 0; i < n; i++ )

d[i] = GET_EXP(ndl,i);

}

return dl;

}

Line 2256 DP ndtodp(int mod,ND p)

Line 2278 DP ndtodp(int mod,ND p)

void ndl_print(unsigned int *dl)

{

int n;

int i,j,l,ord_o,ord_l,s,s0;

int i,j,l,ord_l,s,s0;

struct order_pair *op;

n = nd_nvar;

Line 2265 void ndl_print(unsigned int *dl)

Line 2287 void ndl_print(unsigned int *dl)

l = nd_blockmask->n;

op = nd_blockmask->order_pair;

for ( j = 0, s = s0 = 0; j < l; j++ ) {

ord_o = op[j].order;

ord_l = op[j].length;

if ( !ord_o )

for ( i = 0; i < ord_l; i++, s++ )

for ( i = 0, s0 += ord_l; i < ord_l; i++, s++ )

printf(s==n-1?"%d":"%d,",GET_EXP(dl,s));

printf(s==n-1?"%d":"%d,",GET_EXP(dl,s0-i-1));

else

for ( i = 0; i < ord_l; i++, s++ )

printf(s==n-1?"%d":"%d,",GET_EXP(dl,s));

}

} else {

if ( nd_isrlex )

for ( i = 0; i < n; i++ ) printf(i==n-1?"%d":"%d,",GET_EXP(dl,i));

for ( i = 0; i < n; i++ ) printf(i==n-1?"%d":"%d,",GET_EXP(dl,n-1-i));

else

for ( i = 0; i < n; i++ ) printf(i==n-1?"%d":"%d,",GET_EXP(dl,i));

}

printf(">>");

}

Line 2509 void nd_append_red(unsigned int *d,int i)

Line 2523 void nd_append_red(unsigned int *d,int i)

nd_red[h] = m;

}

unsigned int *dp_compute_bound(DP p)

{

unsigned int *d,*d1,*d2,*t;

MP m;

int i,l;

if ( !p )

return 0;

d1 = (unsigned int *)ALLOCA(nd_nvar*sizeof(unsigned int));

d2 = (unsigned int *)ALLOCA(nd_nvar*sizeof(unsigned int));

m = BDY(p);

d = DL(m)->d;

for ( i = 0; i < nd_nvar; i++ ) d1[i] = d[i];

for ( m = NEXT(BDY(p)); m; m = NEXT(m) ) {

d = DL(m)->d;

for ( i = 0; i < nd_nvar; i++ )

d2[i] = d[i] > d1[i] ? d[i] : d1[i];

t = d1; d1 = d2; d2 = t;

}

l = (nd_nvar+31);

t = (unsigned int *)MALLOC_ATOMIC(l*sizeof(unsigned int));

for ( i = 0; i < nd_nvar; i++ ) t[i] = d1[i];

for ( ; i < l; i++ ) t[i] = 0;

return t;

}

unsigned int *ndv_compute_bound(NDV p)

{

unsigned int *d1,*d2,*t;

int i,l,len;

unsigned int u;

int i,j,k,l,len,ind;

NMV m;

if ( !p )

Line 2553 unsigned int *ndv_compute_bound(NDV p)

Line 2542 unsigned int *ndv_compute_bound(NDV p)

}

l = nd_nvar+31;

t = (unsigned int *)MALLOC_ATOMIC(l*sizeof(unsigned int));

for ( i = 0; i < nd_nvar; i++ ) t[i] = GET_EXP(d1,i);

for ( i = nd_exporigin, ind = 0; i < nd_wpd; i++ ) {

for ( ; i < l; i++ ) t[i] = 0;

u = d1[i];

k = (nd_epw-1)*nd_bpe;

for ( j = 0; j < nd_epw; j++, k -= nd_bpe, ind++ )

t[ind] = (u>>k)&nd_mask0;

}

for ( ; ind < l; ind++ ) t[ind] = 0;

return t;

}

Line 2573 int nd_get_exporigin(struct order_spec *ord)

Line 2567 int nd_get_exporigin(struct order_spec *ord)

}

void nd_setup_parameters() {

int i,n,elen;

int i,j,n,elen,ord_o,ord_l,l,s;

struct order_pair *op;

nd_epw = (sizeof(unsigned int)*8)/nd_bpe;

elen = nd_nvar/nd_epw+(nd_nvar%nd_epw?1:0);

nd_exporigin = nd_get_exporigin(nd_ord);

nd_wpd = nd_exporigin+elen;

nd_epos = (EPOS)MALLOC_ATOMIC(nd_nvar*sizeof(struct oEPOS));

for ( i = 0; i < nd_nvar; i++ ) {

nd_epos[i].i = nd_exporigin + i/nd_epw;

nd_epos[i].s = (nd_epw-(i%nd_epw)-1)*nd_bpe;

}

if ( nd_bpe < 32 ) {

nd_mask0 = (1<<nd_bpe)-1;

} else {

Line 2598 void nd_setup_parameters() {

Line 2589 void nd_setup_parameters() {

}

nm_adv = sizeof(struct oNM)+(nd_wpd-1)*sizeof(unsigned int);

nmv_adv = sizeof(struct oNMV)+(nd_wpd-1)*sizeof(unsigned int);

nd_epos = nd_create_epos(nd_ord);

nd_blockmask = nd_create_blockmask(nd_ord);

}

Line 2701 void nd_reconstruct_direct(int mod,NDV *ps,int len)

Line 2693 void nd_reconstruct_direct(int mod,NDV *ps,int len)

void ndl_reconstruct(int obpe,EPOS oepos,unsigned int *d,unsigned int *r)

{

int n,i,ei,oepw,omask0,j,s,ord_l,ord_o,l;

int n,i,ei,oepw,omask0,j,s,ord_l,l;

struct order_pair *op;

#define GET_EXP_OLD(d,a) (((d)[oepos[a].i]>>oepos[a].s)&omask0)

#define PUT_EXP_OLD(r,a,e) ((r)[oepos[a].i] |= ((e)<<oepos[a].s))

Line 2717 void ndl_reconstruct(int obpe,EPOS oepos,unsigned int

Line 2709 void ndl_reconstruct(int obpe,EPOS oepos,unsigned int

for ( i = 1; i < nd_exporigin; i++ )

r[i] = d[i];

for ( j = 0, s = 0; j < l; j++ ) {

ord_o = op[j].order;

ord_l = op[j].length;

if ( !ord_o )

for ( i = 0; i < ord_l; i++, s++ ) {

for ( i = 0; i < ord_l; i++ ) {

ei = GET_EXP_OLD(d,s);

ei = GET_EXP_OLD(d,s+ord_l-i-1);

PUT_EXP(r,s,ei);

PUT_EXP(r,s+ord_l-i-1,ei);

}

else

for ( i = 0; i < ord_l; i++ ) {

ei = GET_EXP_OLD(d,s+i);

PUT_EXP(r,s+i,ei);

}

s += ord_l;

}

} else {

if ( nd_isrlex )

for ( i = 0; i < n; i++ ) {

ei = GET_EXP_OLD(d,i);

ei = GET_EXP_OLD(d,n-1-i);

PUT_EXP(r,i,ei);

PUT_EXP(r,n-1-i,ei);

}

else

for ( i = 0; i < n; i++ ) {

ei = GET_EXP_OLD(d,i);

PUT_EXP(r,i,ei);

}

Line 2783 int nd_sp(int mod,int trace,ND_pairs p,ND *rp)

Line 2761 int nd_sp(int mod,int trace,ND_pairs p,ND *rp)

NEWNM(m);

CQ(m) = HCQ(p2);

ndl_sub(lcm,HDL(p1),DL(m));

if ( ndl_check_bound2(p->i1,DL(m)) ) return 0;

if ( ndl_check_bound2(p->i1,DL(m)) )

return 0;

t1 = ndv_mul_nm(mod,m,p1);

if ( mod ) CM(m) = mod-HCM(p1);

else chsgnq(HCQ(p1),&CQ(m));

Line 2839 ND weyl_ndv_mul_nm(int mod,NM m0,NDV p) {

Line 2818 ND weyl_ndv_mul_nm(int mod,NM m0,NDV p) {

tab = (NM *)ALLOCA(tlen*sizeof(NM));

psum = (NM *)ALLOCA(tlen*sizeof(NM));

for ( i = 0; i < tlen; i++ ) psum[i] = 0;

for ( i = l-1, m1 = BDY(p)+nmv_adv*(l-1); i >= 0; i--, m1 -= nmv_adv ) {

m1 = (NMV)(((char *)BDY(p))+nmv_adv*(l-1));

for ( i = l-1; i >= 0; i--, NMV_PREV(m1) ) {

/* m0(NM) * m1(NMV) => tab(NM) */

if ( mod )

weyl_mul_nm_nmv(n,mod,m0,m1,tab,tlen);

weyl_mul_nm_nmv(mod,n,m0,m1,tab,tlen);

else

weyl_mul_nm_nmv_q(n,m0,m1,tab,tlen);

for ( j = 0; j < tlen; j++ ) {

if ( tab[j] ) {

NEXT(tab[j]) = psum[j]; psum[j] = tab[j];

Line 2857 ND weyl_ndv_mul_nm(int mod,NM m0,NDV p) {

Line 2834 ND weyl_ndv_mul_nm(int mod,NM m0,NDV p) {

MKND(n,psum[i],j,s);

r = nd_add(mod,r,s);

}

if ( s ) SG(s) = SG(p)+TD(d0);

if ( r ) SG(r) = SG(p)+TD(d0);

return s;

return r;

}

/* product of monomials */

/* XXX block order is not handled correctly */

void weyl_mul_nm_nmv(int n,int mod,NM m0,NMV m1,NM *tab,int tlen)

{

int i,n2,j,s,curlen,homo,h,a,b,k,l,min;

int i,n2,j,s,curlen,homo,h,a,b,k,l,u,min;

unsigned int *d0,*d1,*d,*ctab;

unsigned int *d0,*d1,*d,*dt,*ctab;

Q *ctab_q;

Q q,q1;

unsigned int c0,c1,c;

NM *p;

NM m,t;

Line 2873 void weyl_mul_nm_nmv(int n,int mod,NM m0,NMV m1,NM *ta

Line 2855 void weyl_mul_nm_nmv(int n,int mod,NM m0,NMV m1,NM *ta

if ( !m0 || !m1 ) return;

d0 = DL(m0); d1 = DL(m1); n2 = n>>1;

NEWNM(m); d = DL(m);

c0 = CM(m0); c1 = CM(m1); DMAR(c1,c,0,mod,c); CM(m) = c;

if ( mod ) {

c0 = CM(m0); c1 = CM(m1); DMAR(c0,c1,0,mod,c); CM(m) = c;

} else

mulq(CQ(m0),CQ(m1),&CQ(m));

for ( i = 0; i < nd_wpd; i++ ) d[i] = 0;

homo = n&1 ? 1 : 0;

if ( homo ) {

Line 2881 void weyl_mul_nm_nmv(int n,int mod,NM m0,NMV m1,NM *ta

Line 2866 void weyl_mul_nm_nmv(int n,int mod,NM m0,NMV m1,NM *ta

h = GET_EXP(d0,n-1)+GET_EXP(d1,n-1);

PUT_EXP(DL(m),n-1,h);

TD(DL(m)) = h;

/* XXX other weights */

if ( nd_blockmask ) ndl_set_blockweight(DL(m));

}

tab[0] = m;

curlen = 1;

s = MUL_WEIGHT(a,i)+MUL_WEIGHT(b,n2+i);

NEWNM(m); d = DL(m);

for ( i = 0; i < n2; i++ ) {

for ( i = 0, curlen = 1; i < n2; i++ ) {

a = GET_EXP(d0,i); b = GET_EXP(d1,n2+i);

k = GET_EXP(d0,n2+i); l = GET_EXP(d1,i);

/* xi^a*(Di^k*xi^l)*Di^b */

a += l; b += k;

s = MUL_WEIGHT(a,i)+MUL_WEIGHT(b,n2+i);

if ( !k || !l ) {

for ( j = 0; j < curlen; j++ )

if ( m = tab[j] ) {

if ( t = tab[j] ) {

d = DL(m);

dt = DL(t);

PUT_EXP(d,i,a); PUT_EXP(d,n2+i,b); TD(d) += s;

PUT_EXP(dt,i,a); PUT_EXP(dt,n2+i,b); TD(dt) += s;

/* XXX other weights */

if ( nd_blockmask ) ndl_set_blockweight(dt);

}

curlen *= k+1;

continue;

}

min = MIN(k,l);

ctab = (unsigned int *)ALLOCA((min+1)*sizeof(unsigned int));

if ( mod ) {

mkwcm(k,l,mod,ctab);

ctab = (unsigned int *)ALLOCA((min+1)*sizeof(unsigned int));

for ( j = 0; j < nd_wpd; i++ ) d[j] = 0;

mkwcm(k,l,mod,ctab);

p = tab+curlen;

} else {

for ( j = 1; j <= min; j++ ) {

ctab_q = (Q *)ALLOCA((min+1)*sizeof(Q));

PUT_EXP(d,i,a-j); PUT_EXP(d,n2+i,b-j);

mkwc(k,l,ctab_q);

h = s-(MUL_WEIGHT(a-j,i)+MUL_WEIGHT(b-j,n2+i));

if ( homo ) {

TD(d) = s;

PUT_EXP(d,n-1,h);

} else TD(d) = h;

/* XXX other weights */

c = ctab[j];

for ( k = 0; k < curlen; k++, p++ ) {

NEWNM(t);

ndl_add(DL(tab[k]),d,DL(t));

c0 = CM(tab[k]); DMAR(c0,c,0,mod,c1); CM(t) = c1;

*p = t;

}

/* destructive for j = 0 */

for ( j = min; j >= 0; j-- ) {

PUT_EXP(d,i,a); PUT_EXP(d,n2+i,b);

for ( u = 0; u < nd_wpd; u++ ) d[u] = 0;

h = s-(MUL_WEIGHT(a,i)+MUL_WEIGHT(b,n2+i));

if ( homo ) {

TD(d) = s;

PUT_EXP(d,n-1,h);

} else TD(d) = h;

/* XXX other weights */

c = ctab[0];

p = tab;

for ( k = 0; k < curlen; k++, p++ ) {

ndl_addto(DL(tab[k]),d);

c0 = CM(tab[k]); DMAR(c0,c,0,mod,c1); CM(tab[k]) = c1;

}

curlen *= k+1;

}

FREENM(m);

}

void weyl_mul_nm_nmv_q(int n,NM m0,NMV m1,NM *tab,int tlen)

{

int i,n2,j,s,curlen,homo,h,a,b,k,l,min;

unsigned int *d0,*d1,*d;

Q *ctab;

Q c0,c1,c;

NM *p;

NM m,t;

for ( i = 0; i < tlen; i++ ) tab[i] = 0;

if ( !m0 || !m1 ) return;

d0 = DL(m0); d1 = DL(m1); n2 = n>>1;

NEWNM(m); d = DL(m);

mulq(CQ(m0),CQ(m1),&CQ(m));

for ( i = 0; i < nd_wpd; i++ ) d[i] = 0;

homo = n&1 ? 1 : 0;

if ( homo ) {

/* offset of h-degree */

h = GET_EXP(d0,n-1)+GET_EXP(d1,n-1);

PUT_EXP(DL(m),n-1,h);

TD(DL(m)) = h;

/* XXX other weights */

}

tab[0] = m;

curlen = 1;

s = MUL_WEIGHT(a,i)+MUL_WEIGHT(b,n2+i);

NEWNM(m); d = DL(m);

for ( i = 0; i < n2; i++ ) {

a = GET_EXP(d0,i); b = GET_EXP(d1,n2+i);

k = GET_EXP(d0,n2+i); l = GET_EXP(d1,i);

/* xi^a*(Di^k*xi^l)*Di^b */

a += l; b += k;

if ( !k || !l ) {

for ( j = 0; j < curlen; j++ )

if ( m = tab[j] ) {

d = DL(m);

PUT_EXP(d,i,a); PUT_EXP(d,n2+i,b); TD(d) += s;

/* XXX other weights */

}

curlen *= k+1;

continue;

}

min = MIN(k,l);

ctab = (Q *)ALLOCA((min+1)*sizeof(Q));

mkwc(k,l,ctab);

for ( j = 0; j < nd_wpd; i++ ) d[j] = 0;

p = tab+curlen;

for ( j = 1; j <= min; j++ ) {

PUT_EXP(d,i,a-j); PUT_EXP(d,n2+i,b-j);

h = s-(MUL_WEIGHT(a-j,i)+MUL_WEIGHT(b-j,n2+i));

h = MUL_WEIGHT(a-j,i)+MUL_WEIGHT(b-j,n2+i);

if ( homo ) {

TD(d) = s;

PUT_EXP(d,n-1,h);

PUT_EXP(d,n-1,s-h);

} else TD(d) = h;

/* XXX other weights */

if ( nd_blockmask ) ndl_set_blockweight(d);

c = ctab[j];

if ( mod ) c = ctab[j];

for ( k = 0; k < curlen; k++, p++ ) {

else q = ctab_q[j];

NEWNM(t);

p = tab+curlen*j;

ndl_add(DL(tab[k]),d,DL(t));

if ( j == 0 ) {

mulq(CQ(tab[k]),c,&CQ(t));

for ( u = 0; u < curlen; u++, p++ ) {

*p = t;

if ( tab[u] ) {

ndl_addto(DL(tab[u]),d);

if ( mod ) {

c0 = CM(tab[u]); DMAR(c0,c,0,mod,c1); CM(tab[u]) = c1;

} else {

mulq(CQ(tab[u]),q,&q1); CQ(tab[u]) = q1;

}

} else {

for ( u = 0; u < curlen; u++, p++ ) {

if ( tab[u] ) {

NEWNM(t);

ndl_add(DL(tab[u]),d,DL(t));

if ( mod ) {

c0 = CM(tab[u]); DMAR(c0,c,0,mod,c1); CM(t) = c1;

} else

mulq(CQ(tab[u]),q,&CQ(t));

*p = t;

}

/* destructive for j = 0 */

PUT_EXP(d,i,a); PUT_EXP(d,n2+i,b);

h = s-(MUL_WEIGHT(a,i)+MUL_WEIGHT(b,n2+i));

if ( homo ) {

TD(d) = s;

PUT_EXP(d,n-1,h);

} else TD(d) = h;

/* XXX other weights */

c = ctab[0];

p = tab;

for ( k = 0; k < curlen; k++, p++ ) {

ndl_addto(DL(tab[k]),d);

mulq(CQ(tab[k]),c,&CQ(tab[k]));

}

curlen *= k+1;

}

FREENM(m);

Line 3072 void ndv_realloc(NDV p,int obpe,int oadv,EPOS oepos)

Line 2984 void ndv_realloc(NDV p,int obpe,int oadv,EPOS oepos)

int len,i,k;

#define NMV_OPREV(m) (m = (NMV)(((char *)m)-oadv))

#define NMV_PREV(m) (m = (NMV)(((char *)m)-nmv_adv))

if ( p ) {

m = BDY(p); len = LEN(p);

Line 3259 void nd_init_ord(struct order_spec *ord)

Line 3170 void nd_init_ord(struct order_spec *ord)

nd_isrlex = 0;

ndl_compare_function = ndl_lex_compare;

break;

case 11:

/* XXX */

nd_dcomp = 0;

nd_isrlex = 1;

ndl_compare_function = ndl_ww_lex_compare;

break;

default:

error("nd_gr : unsupported order");

}

Line 3298 BlockMask nd_create_blockmask(struct order_spec *ord)

Line 3215 BlockMask nd_create_blockmask(struct order_spec *ord)

}

return bm;

}

EPOS nd_create_epos(struct order_spec *ord)

{

int i,j,l,s,ord_l,ord_o;

EPOS epos;

struct order_pair *op;

epos = (EPOS)MALLOC_ATOMIC(nd_nvar*sizeof(struct oEPOS));

switch ( ord->id ) {

case 0:

if ( nd_isrlex ) {

for ( i = 0; i < nd_nvar; i++ ) {

epos[i].i = nd_exporigin + (nd_nvar-1-i)/nd_epw;

epos[i].s = (nd_epw-((nd_nvar-1-i)%nd_epw)-1)*nd_bpe;

}

} else {

for ( i = 0; i < nd_nvar; i++ ) {

epos[i].i = nd_exporigin + i/nd_epw;

epos[i].s = (nd_epw-(i%nd_epw)-1)*nd_bpe;

}

break;

case 1:

/* block order */

l = ord->ord.block.length;

op = ord->ord.block.order_pair;

for ( j = 0, s = 0; j < l; j++ ) {

ord_o = op[j].order;

ord_l = op[j].length;

if ( !ord_o )

for ( i = 0; i < ord_l; i++ ) {

epos[s+i].i = nd_exporigin + (s+ord_l-i-1)/nd_epw;

epos[s+i].s = (nd_epw-((s+ord_l-i-1)%nd_epw)-1)*nd_bpe;

}

else

for ( i = 0; i < ord_l; i++ ) {

epos[s+i].i = nd_exporigin + (s+i)/nd_epw;

epos[s+i].s = (nd_epw-((s+i)%nd_epw)-1)*nd_bpe;

}

s += ord_l;

}

break;

case 2:

error("nd_create_epos : matrix order is not supported yet.");

}

return epos;

}

/* external interface */

void nd_nf_p(P f,LIST g,LIST v,int m,struct order_spec *ord,P *rp)

{

NODE t;

ND nd,nf;

VL vv;

DP d,r,dm;

int stat;

pltovl(v,&vv);

nd_nvar = length(vv);

nd_init_ord(ord);

initd(ord);

for ( t = BDY(g); NEXT(t); t = NEXT(t) ) {

ptod(CO,vv,(P)BDY(t),&d); BDY(t) = (pointer)d;

}

ptod(CO,vv,(P)BDY(t),&d); BDY(t) = (pointer)d;

NEWNODE(NEXT(t)); ptod(CO,vv,f,&d); BDY(NEXT(t)) = d; NEXT(NEXT(t)) = 0;

nd_setup(m,0,BDY(g));

nd_psn--;

nd_scale=2;

while ( 1 ) {

nd = (pointer)ndvtond(m,nd_ps[nd_psn]);

stat = nd_nf(m,nd,nd_ps,1,&nf);

if ( !stat ) {

nd_psn++;

nd_reconstruct(m,0,0);

nd_psn--;

} else

break;

}

r = (DP)ndtodp(m,nf);

if ( m ) _dtop_mod(CO,vv,r,rp);

else dtop(CO,vv,r,rp);

}

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