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.28 and 1.38

version 1.28, 2001/09/13 03:04:27

version 1.38, 2001/11/16 10:35:07

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.27 2001/09/11 08:56:47 noro Exp $

* $OpenXM: OpenXM_contrib2/asir2000/builtin/gr.c,v 1.37 2001/10/09 01:36:06 noro Exp $

#include "ca.h"

#include "parse.h"

Line 60

#define INLINE

#endif

#define ITOS(p) (((unsigned int)(p))&0x7fffffff)

#define STOI(i) ((P)((unsigned int)(i)|0x80000000))

#define NEXTVL(r,c) \

if(!(r)){NEWVL(r);(c)=(r);}else{NEWVL(NEXT(c));(c)=NEXT(c);}

#define HMAG(p) (p_mag(BDY(p)->c))

struct dp_pairs {

#define NEWDP_pairs ((DP_pairs)MALLOC(sizeof(struct dp_pairs)))

int dp1, dp2;

DL lcm;

int sugar;

struct dp_pairs *next;

};

typedef struct dp_pairs *DP_pairs;

static DP_pairs collect_pairs_of_hdlcm( DP_pairs d1, DP_pairs *prest );

double get_rtime();

#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_nf,eg_nfm;

struct oEGT eg_znfm,eg_pz,eg_np,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;

extern DP_Print;

void dp_imul_d(DP,Q,DP *);

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(NODE,DP,DP *,int,DP *);

void _dp_nf_z(NODE,DP,DP *,int,int,DP *);

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,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);

DLBUCKET dp_dllist_bucket(DP f);

NODE symb_merge(NODE,NODE,int),_symb_merge(NODE,NODE,int);

DLBUCKET symb_merge_bucket(DLBUCKET,DLBUCKET,int);

extern int dp_nelim;

extern int dp_fcoeffs;

static DP *ps,*psm;

Line 192 int doing_f4;

Line 115 int doing_f4;

NODE TraceList;

NODE AllTraceList;

INLINE int eqdl(nv,dl1,dl2)

void Pox_cmo_rpc(NODE,Obj *);

int nv;

void Pox_rpc(NODE,Obj *);

DL dl1,dl2;

void Pox_pop_local(NODE,Obj *);

INLINE int eqdl(int nv,DL dl1,DL dl2)

{

int i;

int *b1,*b2;

Line 212 DL dl1,dl2;

Line 137 DL dl1,dl2;

/* b[] should be cleared */

void _dpmod_to_vect(f,at,b)

void _dpmod_to_vect(DP f,DL *at,int *b)

DP f;

DL *at;

int *b;

{

int i,nv;

MP m;

Line 227 int *b;

Line 149 int *b;

}

/* create compressed poly */

/* [t,findex] -> tf -> compressed vector */

void _dpmod_to_vect_compress(f,at,b)

void _tf_to_vect_compress(NODE tf,DL *at,CDP *b)

DP f;

DL *at;

CDP *b;

{

int i,j,nv,len;

int i,j,k,nv,len;

DL t,s,d1;

DP f;

MP m;

CDP r;

t = (DL)BDY(tf);

f = ps[(int)BDY(NEXT(tf))];

nv = f->nv;

for ( m = BDY(f), len = 0; m; m = NEXT(m), len++ );

r = (CDP)MALLOC(sizeof(struct oCDP));

r->len = len;

r->body = (CM)MALLOC(sizeof(struct oCM)*len);

r->psindex = (int)BDY(NEXT(tf));

r->body = (unsigned int *)MALLOC_ATOMIC(sizeof(unsigned int)*len);

NEWDL_NOINIT(s,nv);

for ( m = BDY(f), i = j = 0; m; m = NEXT(m), j++ ) {

for ( ; !eqdl(nv,m->dl,at[i]); i++ );

d1 = m->dl;

r->body[j].index = i;

s->td = t->td+d1->td;

r->body[j].c = ITOS(m->c);

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;

}

/* dense vector -> CDP */

void dp_to_vect(DP f,DL *at,Q *b)

void compress_vect(a,n,rp)

int *a;

int n;

CDP *rp;

{

int i,j,nz;

CDP r;

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

if ( a[i] ) nz++;

*rp = r = (CDP)MALLOC(sizeof(struct oCDP));

r->len = nz;

r->body = (CM)MALLOC(sizeof(struct oCM)*nz);

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

if ( a[i] ) {

r->body[j].index = i;

r->body[j].c = ITOS(a[i]);

j++;

}

void dp_to_vect(f,at,b)

DP f;

DL *at;

Q *b;

{

int i,nv;

MP m;

Line 290 Q *b;

Line 193 Q *b;

}

NODE dp_dllist(f)

NODE dp_dllist(DP f)

DP f;

{

MP m;

NODE mp,mp0;

Line 306 DP f;

Line 208 DP f;

return mp0;

}

void print_dlbucket(d,nv)

NODE mul_dllist(DL d,DP f)

DLBUCKET d;

int nv;

{

int i;

NODE n;

for ( ; d; d = NEXT(d) ) {

fprintf(stderr,"td = %d\n",d->td);

for ( n = BDY(d); n; n = NEXT(n) ) {

fprintf(stderr,"<");

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

fprintf(stderr,"%d",((DL)BDY(n))->d[i]);

if ( i != nv-1 )

fprintf(stderr," ");

}

fprintf(stderr,">");

}

fprintf(stderr,"\n");

}

DLBUCKET dp_dllist_bucket(f)

DP f;

{

MP m;

NODE n,n0;

NODE mp,mp0;

DLBUCKET d,d0;

DL t,d1;

int td;

int i,nv;

if ( !f )

return 0;

d0 = 0;

nv = NV(f);

m = BDY(f);

mp0 = 0;

do {

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

NEXTDLBUCKET(d0,d);

NEXTNODE(mp0,mp);

n0 = 0;

NEWDL_NOINIT(t,nv);

d->td = td = m->dl->td;

d1 = m->dl;

do {

t->td = d->td+d1->td;

NEXTNODE(n0,n);

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

BDY(n) = (pointer)m->dl;

t->d[i] = d->d[i]+d1->d[i];

m = NEXT(m);

BDY(mp) = (pointer)t;

} while ( m && m->dl->td == td );

}

NEXT(n) = 0;

NEXT(mp) = 0;

BDY(d) = n0;

return mp0;

} while ( m );

NEXT(d) = 0;

return d0;

}

void pdl(f)

void pdl(NODE f)

NODE f;

{

while ( f ) {

printdl(BDY(f)); f = NEXT(f);

Line 366 NODE f;

Line 241 NODE f;

printf("\n");

}

void dp_gr_main(f,v,homo,modular,field,ord,rp)

void dp_gr_main(LIST f,LIST v,Num homo,int modular,int field,struct order_spec *ord,LIST *rp)

LIST f,v;

Num homo;

int modular,field;

struct order_spec *ord;

LIST *rp;

{

int i,mindex,m,nochk;

struct order_spec ord1;

Line 471 LIST *rp;

Line 341 LIST *rp;

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;

VL fv,vv,vc;

Line 541 extern struct oEGT eg_red_mod;

Line 406 extern struct oEGT eg_red_mod;

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,homogen;

int homogen;

struct order_spec ord1;

VL fv,vv,vc;

NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx;

NODE fd,fd0,r,r0,t,x,s,xx;

dp_fcoeffs = 0;

get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);

Line 577 LIST *rp;

Line 438 LIST *rp;

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,homogen;

int homogen;

struct order_spec ord1;

VL fv,vv,vc;

DP b,c,c1;

NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx;

NODE fd,fd0,r,r0,t,x,s,xx;

dp_fcoeffs = 0;

get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);

Line 608 LIST *rp;

Line 464 LIST *rp;

}

if ( fd0 ) NEXT(fd) = 0;

setup_arrays(fd0,m,&s);

x = gb_f4_mod(s,m);

init_stat();

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;

}

Line 617 LIST *rp;

Line 477 LIST *rp;

}

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 s,s0;

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;

NODE blist,bt,nt;

NODE blist,bt;

DL *ht,*at;

MAT mat,nm;

int *colstat;

int *rind,*cind;

int rank,nred;

Q dn;

struct oEGT tmp0,tmp1,tmp2,eg_split_symb,eg_split_elim;

struct oEGT tmp0,tmp1,eg_split_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);

Line 740 NODE f;

Line 599 NODE f;

/* initial bases are monic */

NODE gb_f4_mod(f,m)

unsigned int **psca;

NODE f;

int m;

NODE gb_f4_mod(NODE f,int m)

{

int i,j,k,nh,row,col,nv;

NODE r,g,gall;

NODE sb;

NODE s,s0;

DLBUCKET s,s0,s1;

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;

NODE blist,bt,nt;

NODE blist,bt,bt1,dt;

DL *ht,*at,*st;

DL *at,*st;

int **spmat;

CDP *redmat;

int *colstat,*w,*w1;

int rank,nred,nsp,nonzero,spcol;

int rank,nred,nsp,nsp0,nonzero,spcol;

int *indred,*isred;

CDP ri;

struct oEGT tmp0,tmp1,tmp2,eg_split_symb,eg_split_elim1,eg_split_elim2;

int pscalen;

struct oEGT tmp0,tmp1,eg_split_symb,eg_split_elim1,eg_split_elim2;

extern struct oEGT eg_symb,eg_elim1,eg_elim2;

/* initialize coeffcient array list of ps[] */

pscalen = pslen;

psca = (unsigned int **)MALLOC(pscalen*sizeof(unsigned int *));

init_eg(&eg_symb); init_eg(&eg_elim1); init_eg(&eg_elim2);

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);

dptoca(ps[i],&psca[i]);

}

if ( gall )

nv = ((DP)ps[(int)BDY(gall)])->nv;

Line 780 int m;

Line 644 int m;

/* 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;

s0 = symb_merge_bucket(s0,dp_dllist_bucket(sp),nv);

s0 = symb_merge(s0,dp_dllist(sp),nv);

/* print_dlbucket(s0,nv); */

/* fprintf(stderr,"%d-",length(s0)); */

}

if ( DP_Print )

fprintf(asir_out,"initial spmat : %d x %d ",length(blist),length(s0));

/* s0 : all the terms appeared in symbolic reduction */

#if 0

for ( s = s0, nred = 0; s; s = NEXT(s) ) {

sb = BDY(s);

for ( r = gall; r; r = NEXT(r) )

for ( ; sb; sb = NEXT(sb) ) {

if ( _dl_redble(BDY(ps[(int)BDY(r)])->dl,BDY(s),nv) )

for ( j = psn-1; j >= 0; j-- )

break;

if ( _dl_redble(BDY(ps[j])->dl,BDY(sb),nv) )

if ( r ) {

break;

dltod(BDY(s),nv,&tdp);

if ( j >= 0 ) {

dp_subd(tdp,ps[(int)BDY(r)],&sd);

dltod(BDY(sb),nv,&tdp);

dt = mul_dllist(BDY(sd)->dl,ps[(int)BDY(r)]);

dp_subd(tdp,ps[j],&sd);

/* fprintf(stderr,"[%d]",length(dt)); */

for ( k = 0, i = 0; k < nv; k++ )

/* list of [t,f] */

if ( BDY(sd)->dl->d[k] )

bt1 = mknode(2,BDY(sd)->dl,BDY(r));

i++;

MKNODE(bt,bt1,blist); blist = bt;

fprintf(stderr,"%c ",i<=1 ? 'o' : 'x');

symb_merge(s,dt,nv);

_dp_mod(sd,m,0,&sdm);

/* fprintf(stderr,"%d-",length(s)); */

mulmd_dup(m,sdm,ps[j],&f2);

nred++;

MKNODE(bt,f2,blist); blist = bt;

/* merge the highest degree part into sb */

s1 = dp_dllist_bucket(f2);

symb_merge(sb,BDY(s1),nv);

/* merge the rest into s */

symb_merge_bucket(s,NEXT(s1),nv);

nred++;

}

#else

/* fprintf(stderr,"\n"); */

for ( s = s0, nred = 0; s; s = NEXT(s) ) {

if ( DP_Print )

sb = BDY(s);

fprintf(asir_out,"number of reducers : %d\n",nred);

for ( ; sb; sb = NEXT(sb) ) {

for ( r = gall; r; r = NEXT(r) )

if ( _dl_redble(BDY(ps[(int)BDY(r)])->dl,BDY(sb),nv) )

break;

if ( r ) {

dltod(BDY(sb),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;

/* merge the highest degree part into sb */

s1 = dp_dllist_bucket(f2);

symb_merge(sb,BDY(s1),nv);

/* merge the rest into s */

symb_merge_bucket(s,NEXT(s1),nv);

nred++;

}

#endif

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 */

/* row = the number of all the polys */

for ( r = blist, row = 0; r; r = NEXT(r), row++ );

/* head terms of reducers */

ht = (DL *)MALLOC(nred*sizeof(DL));

for ( r = blist, i = 0; i < nred; r = NEXT(r), i++ )

ht[i] = BDY((DP)BDY(r))->dl;

/* col = number of all terms */

for ( s = s0, col = 0; s; s = NEXT(s) )

for ( s = s0, col = 0; s; s = NEXT(s), col++ );

for ( sb = BDY(s); sb; sb = NEXT(sb) )

col++;

/* head terms of all terms */

at = (DL *)MALLOC(col*sizeof(DL));

for ( s = s0, i = 0; i < col; s = NEXT(s) )

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

for ( sb = BDY(s); sb; sb = NEXT(sb), i++ )

at[i] = (DL)BDY(s);

at[i] = (DL)BDY(sb);

/* store coefficients separately in spmat and redmat */

nsp = row-nred;

/* reducer matrix */

/* indred : register the position of the head term */

#if 0

reduce_reducers_mod_compress(blist,nred,at,col,m,&redmat,&indred);

isred = (int *)MALLOC(col*sizeof(int));

bzero(isred,col*sizeof(int));

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

isred[indred[i]] = 1;

#else

redmat = (CDP *)MALLOC(nred*sizeof(CDP));

for ( i = 0, r = blist; i < nred; r = NEXT(r), i++ )

_dpmod_to_vect_compress(BDY(r),at,&redmat[i]);

_tf_to_vect_compress(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));

indred = (int *)MALLOC_ATOMIC(nred*sizeof(int));

bzero(indred,nred*sizeof(int));

isred = (int *)MALLOC(col*sizeof(int));

isred = (int *)MALLOC_ATOMIC(col*sizeof(int));

bzero(isred,col*sizeof(int));

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

ri = redmat[i];

indred[i] = ri->body[0].index;

indred[i] = ri->body[0];

isred[indred[i]] = 1;

}

#endif

spcol = col-nred;

/* head terms not in ht */

Line 894 int m;

Line 713 int m;

for ( j = 0, k = 0; j < col; j++ )

if ( !isred[j] )

st[k++] = at[j];

get_eg(&tmp1); add_eg(&eg_symb,&tmp0,&tmp1);

init_eg(&eg_split_symb); add_eg(&eg_split_symb,&tmp0,&tmp1);

get_eg(&tmp1);

/* spoly matrix; stored in reduced form; terms in ht[] are omitted */

spmat = (int **)MALLOC(nsp*sizeof(int *));

w = (int *)MALLOC(col*sizeof(int));

w = (int *)MALLOC_ATOMIC(col*sizeof(int));

/* skip reducers in blist */

for ( i = 0, r = blist; i < nred; r = NEXT(r), i++ );

Line 919 int m;

Line 740 int m;

}

/* update nsp */

nsp0 = nsp;

nsp = i;

/* XXX free redmat explicitly */

for ( k = 0; k < nred; k++ ) {

GC_free(BDY(redmat[k]));

GC_free(redmat[k]);

}

get_eg(&tmp0); add_eg(&eg_elim1,&tmp1,&tmp0);

init_eg(&eg_split_elim1); add_eg(&eg_split_elim1,&tmp1,&tmp0);

Line 948 int m;

Line 776 int m;

fprintf(asir_out,"\n");

}

NZR += rank;

ZR += nsp0-rank;

if ( !rank )

continue;

Line 963 int m;

Line 794 int m;

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++ ) {

GC_free(spmat[j]);

}

if ( DP_Print ) {

print_eg("Symb",&eg_symb);

Line 978 int m;

Line 820 int m;

return g;

}

int DPPlength(n)

NODE gb_f4_mod_old(NODE f,int m)

DP_pairs n;

{

int i,j,k,nh,row,col,nv;

NODE r,g,gall;

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;

init_eg(&eg_symb); init_eg(&eg_elim1); init_eg(&eg_elim2);

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);

}

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; 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);

/* 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 reducers */

ht = (DL *)MALLOC(nred*sizeof(DL));

for ( r = blist, i = 0; i < nred; r = NEXT(r), i++ )

ht[i] = BDY((DP)BDY(r))->dl;

/* col = number of all terms */

for ( s = s0, col = 0; s; s = NEXT(s), col++ );

/* head terms of all terms */

at = (DL *)MALLOC(col*sizeof(DL));

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

at[i] = (DL)BDY(s);

/* store coefficients separately in spmat and redmat */

nsp = row-nred;

/* reducer matrix */

redmat = (int **)almat(nred,col);

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;

/* 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];

/* spoly matrix; stored in reduced form; terms in ht[] are omitted */

spmat = almat(nsp,spcol);

w = (int *)MALLOC(col*sizeof(int));

for ( ; i < row; r = NEXT(r), i++ ) {

bzero(w,col*sizeof(int));

_dpmod_to_vect(BDY(r),at,w);

reduce_sp_by_red_mod(w,redmat,indred,nred,col,m);

for ( j = 0, k = 0; j < col; j++ )

if ( !isred[j] )

spmat[i-nred][k++] = w[j];

}

get_eg(&tmp0); add_eg(&eg_elim1,&tmp1,&tmp0);

init_eg(&eg_split_elim1); add_eg(&eg_split_elim1,&tmp1,&tmp0);

colstat = (int *)MALLOC_ATOMIC(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);

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 = 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 ( DP_Print ) {

print_eg("Symb",&eg_symb);

print_eg("Elim1",&eg_elim1);

print_eg("Elim2",&eg_elim2);

fflush(asir_out);

}

return g;

}

int DPPlength(DP_pairs n)

{

int i;

for ( i = 0; n; n = NEXT(n), i++ );

return i;

}

void printdl(dl)

void printdl(DL dl)

DL dl;

{

int i;

Line 998 DL dl;

Line 1006 DL dl;

fprintf(asir_out,"%d>>",dl->d[i]);

}

void pltovl(l,vl)

void pltovl(LIST l,VL *vl)

LIST l;

VL *vl;

{

NODE n;

VL r,r0;

Line 1013 VL *vl;

Line 1019 VL *vl;

*vl = r0;

}

void makesubst(v,s)

void makesubst(VL v,NODE *s)

VL v;

NODE *s;

{

NODE r,r0;

Q q;

Line 1034 NODE *s;

Line 1038 NODE *s;

*s = r0;

}

void printsubst(s)

void printsubst(NODE s)

NODE s;

{

fputc('[',asir_out);

while ( s ) {

Line 1049 NODE s;

Line 1052 NODE s;

fprintf(asir_out,"]\n"); return;

}

void vlminus(v,w,d)

void vlminus(VL v,VL w,VL *d)

VL v,w,*d;

{

int i,j,n,m;

V *va,*wa;

Line 1080 VL v,w,*d;

Line 1082 VL v,w,*d;

*d = r0;

}

int validhc(a,m,s)

int validhc(P a,int m,NODE s)

P a;

int m;

NODE s;

{

P c,c1;

V v;

Line 1098 NODE s;

Line 1097 NODE s;

return c1 ? 1 : 0;

}

void setup_arrays(f,m,r)

void setup_arrays(NODE f,int m,NODE *r)

NODE f,*r;

int m;

{

int i;

NODE s,s0,f0;

Line 1128 int m;

Line 1125 int m;

STRING fname;

LIST input;

NODE arg,t,t1;

Obj dmy;

Obj obj;

t = 0;

for ( i = psn-1; i >= 0; i-- ) {

Line 1141 int m;

Line 1138 int m;

STOQ(OXCheck,q);

MKSTR(fname,"register_input");

arg = mknode(3,q,fname,input);

Pox_cmo_rpc(arg,&dmy);

Pox_cmo_rpc(arg,&obj);

} else if ( OXCheck < 0 ) {

MKNODE(AllTraceList,input,0);

}

Line 1153 int m;

Line 1150 int m;

*r = s0;

}

void prim_part(f,m,r)

void prim_part(DP f,int m,DP *r)

DP f,*r;

int m;

{

P d,t;

Line 1181 int m;

Line 1176 int m;

}

NODE /* of DP */ NODE_sortb_insert( newdp, nd, dec )

NODE /* of DP */ NODE_sortb_insert( DP newdp, NODE /* of DP */ nd, int dec )

DP newdp;

NODE /* of DP */ nd;

int dec;

{

Line 1203 int dec;

Line 1195 int dec;

return nd;

}

NODE NODE_sortb( node, dec )

NODE NODE_sortb( NODE node, int dec )

NODE node;

int dec;

{

Line 1214 int dec;

Line 1204 int dec;

return ans;

}

NODE /* of index */ NODE_sortbi_insert( newdpi, nd, dec )

NODE /* of index */ NODE_sortbi_insert( int newdpi, NODE /* of index */ nd, int dec )

int newdpi;

NODE /* of index */ nd;

int dec;

{

Line 1236 int dec;

Line 1223 int dec;

return nd;

}

NODE NODE_sortbi( node, dec )

NODE NODE_sortbi( NODE node, int dec )

NODE node;

int dec;

{

Line 1247 int dec;

Line 1232 int dec;

return ans;

}

void reduceall(in,h)

void reduceall(NODE in,NODE *h)

NODE in;

NODE *h;

{

NODE r,t,top;

int n,i,j;

Line 1302 NODE *h;

Line 1285 NODE *h;

fprintf(asir_out,"\n");

}

void reduceall_mod(in,m,h)

void reduceall_mod(NODE in,int m,NODE *h)

NODE in;

int m;

NODE *h;

{

NODE r,t,top;

int n,i,j;

Line 1350 NODE *h;

Line 1330 NODE *h;

fprintf(asir_out,"\n");

}

int newps(a,m,subst)

int newps(DP a,int m,NODE subst)

DP a;

int m;

NODE subst;

{

if ( m && !validhc(!a?0:BDY(a)->c,m,subst) )

return -1;

Line 1385 NODE subst;

Line 1362 NODE subst;

NODE arg;

Q q1,q2;

STRING fname;

Obj dmy;

Obj obj;

/* reverse the TraceList */

tn = TraceList;

Line 1398 NODE subst;

Line 1375 NODE subst;

MKSTR(fname,"check_trace");

STOQ(psn,q2);

arg = mknode(5,q1,fname,a,q2,trace);

Pox_cmo_rpc(arg,&dmy);

Pox_cmo_rpc(arg,&obj);

} else if ( OXCheck < 0 ) {

STOQ(psn,q1);

tn = mknode(2,q1,trace);

Line 1412 NODE subst;

Line 1389 NODE subst;

return psn++;

}

int newps_nosave(a,m,subst)

int newps_nosave(DP a,int m,NODE subst)

DP a;

int m;

NODE subst;

{

if ( m && !validhc(!a?0:BDY(a)->c,m,subst) )

return -1;

Line 1437 NODE subst;

Line 1411 NODE subst;

return psn++;

}

int newps_mod(a,m)

int newps_mod(DP a,int m)

DP a;

int m;

{

if ( psn == pslen ) {

pslen *= 2;

Line 1454 int m;

Line 1426 int m;

return psn++;

}

void reducebase_dehomo(f,g)

void reducebase_dehomo(NODE f,NODE *g)

NODE f,*g;

{

int n,i,j,k;

int *r;

Line 1501 NODE f,*g;

Line 1472 NODE f,*g;

*g = top;

}

NODE append_one(f,n)

NODE append_one(NODE f,int n)

NODE f;

int n;

{

NODE t;

Line 1516 int n;

Line 1485 int n;

}

DP_pairs minp( d, prest )

DP_pairs minp( DP_pairs d, DP_pairs *prest )

DP_pairs d, *prest;

{

Line 1542 DP_pairs d, *prest;

Line 1510 DP_pairs d, *prest;

return m;

}

void minsugar(d,dm,dr)

void minsugar(DP_pairs d,DP_pairs *dm,DP_pairs *dr)

DP_pairs d;

DP_pairs *dm,*dr;

{

int msugar;

DP_pairs t,dm0,dr0,dmt,drt;

Line 1569 DP_pairs *dm,*dr;

Line 1535 DP_pairs *dm,*dr;

*dm = dm0; *dr = dr0;

}

NODE gb(f,m,subst)

NODE gb(NODE f,int m,NODE subst)

NODE f;

int m;

NODE subst;

{

int i,nh,prev,mag;

NODE r,g,gall;

DP_pairs d,d1;

DP_pairs d;

DP_pairs l;

DP h,nf,nfm,dp1,dp2;

MP mp;

struct oEGT tnf0,tnf1,tnfm0,tnfm1,tpz0,tpz1,tsp0,tsp1,tspm0,tspm1,tnp0,tnp1,tmp0,tmp1;

struct oEGT tnf0,tnf1,tnfm0,tnfm1,tpz0,tpz1,tnp0,tnp1;

int skip_nf_flag;

double t_0;

Q q;

Line 1619 NODE subst;

Line 1582 NODE subst;

if ( Demand ) {

if ( dp_load_t(psn,&nf) ) {

skip_nf_flag = 1;

tnf1=tsp1;

goto skip_nf;

} else {

skip_nf_flag = 0;

Line 1700 skip_nf:

Line 1662 skip_nf:

return g;

}

NODE gb_mod(f,m)

NODE gb_mod(NODE f,int m)

NODE f;

int m;

{

int i,nh,prev;

NODE r,g,gall;

DP_pairs d,d1;

DP_pairs d;

DP_pairs l;

DP h,nf;

struct oEGT tnfm0,tnfm1,tspm0,tspm1,tmp0,tmp1,tpz0,tpz1;

struct oEGT tnfm0,tnfm1,tpz0,tpz1;

prev = 1;

for ( gall = g = 0, d = 0, r = f; r; r = NEXT(r) ) {

Line 1764 int m;

Line 1724 int m;

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;

{

struct oEGT tup0,tup1;

int dl,dl1;

if ( !g ) return d;

Line 1805 int t;

Line 1761 int t;

return d;

}

DP_pairs newpairs( g, t )

DP_pairs newpairs( NODE /* of index */ g, int t )

NODE /* of index */ g;

{

Line 1833 register int t;

Line 1787 register int t;

return last;

}

DP_pairs criterion_B( d, s )

DP_pairs criterion_B( DP_pairs d, int s )

int s;

{

Line 1858 int s;

Line 1810 int s;

return dd;

}

DP_pairs criterion_M( d1 )

DP_pairs criterion_M( DP_pairs d1 )

DP_pairs d1;

{

Line 1901 DP_pairs d1;

Line 1852 DP_pairs d1;

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;

{

Line 1926 DP_pairs d1, *prest;

Line 1876 DP_pairs d1, *prest;

return w;

}

int criterion_2( dp1, dp2 )

int criterion_2( int dp1, int dp2 )

int dp1, dp2;

{

Line 1937 int dp1, dp2;

Line 1886 int dp1, dp2;

return 1;

}

DP_pairs criterion_F( d1 )

DP_pairs criterion_F( DP_pairs d1 )

DP_pairs d1;

{

DP_pairs rest, head;

Line 1961 DP_pairs d1;

Line 1909 DP_pairs d1;

return head;

}

NODE updbase(g,t)

NODE updbase(NODE g,int t)

NODE g;

int t;

{

g = remove_reducibles(g,t);

g = append_one(g,t);

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;

{

Line 1993 int newdp;

Line 1937 int newdp;

return head;

}

int dl_redble( dl1, dl2 )

int dl_redble(DL dl1,DL dl2)

DL dl1, dl2;

{

Line 2003 DL dl1, dl2;

Line 1946 DL dl1, dl2;

return 1;

}

int dl_weight(dl)

int dl_weight(DL dl)

DL dl;

{

int n,w,i;

Line 2014 DL dl;

Line 1956 DL dl;

return w;

}

int gbcheck(f)

int gbcheck(NODE f)

NODE f;

{

int i;

NODE r,g,gall;

Line 2053 NODE f;

Line 1994 NODE f;

return 1;

}

int membercheck(f,x)

void gbcheck_list(NODE f,LIST *gp,LIST *pp)

NODE f,x;

{

int i;

NODE r,g,gall,u,u0,t;

LIST pair;

DP_pairs d,l;

Q q1,q2;

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);

}

for ( u0 = 0, t = gall; t; t = NEXT(t) ) {

NEXTNODE(u0,u);

BDY(u) = ps[(int)BDY(t)];

}

if ( u0 )

NEXT(u) = 0;

MKLIST(*gp,u);

for ( u0 = 0, l = d; l; l = NEXT(l) ) {

NEXTNODE(u0,u);

STOQ(l->dp1,q1);

STOQ(l->dp2,q2);

t = mknode(2,q1,q2);

MKLIST(pair,t);

BDY(u) = (pointer)pair;

}

if ( u0 )

NEXT(u) = 0;

MKLIST(*pp,u);

}

int membercheck(NODE f,NODE x)

{

DP g;

struct oEGT tmp0,tmp1;

Line 2081 NODE f,x;

Line 2055 NODE f,x;

return 1;

}

void dp_set_flag(name,value)

void dp_set_flag(Obj name,Obj value)

Obj name,value;

{

char *n;

int v;

Line 2137 Obj name,value;

Line 2110 Obj name,value;

OXCheck = v;

}

void dp_make_flaglist(list)

void dp_make_flaglist(LIST *list)

LIST *list;

{

Q v;

STRING name,path;

Line 2173 LIST *list;

Line 2145 LIST *list;

#define DELIM '/'

void dp_save(index,p,prefix)

void dp_save(int index,Obj p,char *prefix)

int index;

Obj p;

char *prefix;

{

FILE *fp;

char path[BUFSIZ];

Line 2190 char *prefix;

Line 2159 char *prefix;

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;

char path[BUFSIZ];

Line 2207 DP *p;

Line 2174 DP *p;

}

int dp_load_t(index,p)

int dp_load_t(int index,DP *p)

int index;

DP *p;

{

FILE *fp;

char path[BUFSIZ];

Line 2226 void init_stat() {

Line 2191 void init_stat() {

init_eg(&eg_nf); init_eg(&eg_nfm); init_eg(&eg_znfm);

init_eg(&eg_pz); init_eg(&eg_np);

init_eg(&eg_ra); init_eg(&eg_mc); init_eg(&eg_gc);

ZR = NZR = TP = NBP = NFP = NDP = 0;

ZR = NZR = TP = NMP = NBP = NFP = NDP = 0;

}

void print_stat() {

Line 2249 extern int GenTrace;

Line 2214 extern int GenTrace;

extern NODE TraceList;

extern int mpi_mag;

void dp_mulc_d(p,c,r)

void dp_mulc_d(DP p,P c,DP *r)

DP p;

P c;

DP *r;

{

if ( Dist && BDY(Dist)

&& HMAG(p) > mpi_mag

Line 2265 DP *r;

Line 2227 DP *r;

}

void _dp_nf(b,g,ps,full,rp)

void _dp_nf(NODE b,DP g,DP *ps,int full,DP *rp)

NODE b;

DP g;

DP *ps;

int full;

DP *rp;

{

DP u,p,d,s,t,mult;

P coef;

Line 2328 DP *rp;

Line 2285 DP *rp;

*rp = d;

}

void _dp_nf_z(b,g,ps,full,multiple,r)

void _dp_nf_z(NODE b,DP g,DP *ps,int full,int multiple,DP *r)

NODE b;

DP g;

DP *ps;

int full,multiple;

DP *r;

{

DP u,dp,rp,t,t1,t2,red,shift;

DP u,dp,rp,t,t1,red,shift;

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 kara_bit;

double t_0,tt,t_p,t_m,t_g,t_a;

double get_rtime();

double t_0,t_00,tt,ttt,t_p,t_m,t_g,t_a;

LIST hist;

NODE node;

Q rcred,mrcred;

Line 2375 DP *r;

Line 2322 DP *r;

tt = get_rtime(); t_p += tt-t_0;

dp_subd(rp,red,&shift);

dp_mulc_d(rp,cr,&t);

dp_mulc_d(rp,(P)cr,&t);

chsgnp((P)cred,(P *)&mcred);

dp_mulc_d(red,mcred,&t1);

dp_mulc_d(red,(P)mcred,&t1);

muld(CO,shift,t1,&t1);

addd(CO,t,t1,&u);

t_m += get_rtime()-tt;

Line 2472 final:

Line 2419 final:

void imulv();

void dp_imul_d(p,q,rp)

void dp_imul_d(DP p,Q q,DP *rp)

DP p;

Q q;

DP *rp;

{

int nsep,ndist,i,j,k,l,n;

double t0,t1,t2;

Line 2484 DP *rp;

Line 2428 DP *rp;

VECT c,cs,ri;

VECT *r;

MP m;

NODE tn,dist,n0,n1,n2;

NODE tn,dist,n0;

Obj dmy;

Obj obj;

STRING imul;

extern LIST Dist;

Line 2506 DP *rp;

Line 2450 DP *rp;

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,&dmy);

Pox_rpc(n0,&obj);

}

t1 = get_rtime();

im_t_s += t1 - t0;

Line 2514 DP *rp;

Line 2458 DP *rp;

t1 = get_rtime();

for ( i = 0, tn = dist; i < ndist; i++, tn = NEXT(tn) ) {

MKNODE(n0,BDY(tn),0);

Pox_pop_local(n0,&r[i]);

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");

Line 2531 DP *rp;

Line 2475 DP *rp;

dp_vtod(s,p,rp);

}

void imulv(w,c,rp)

void imulv(VECT w,Q c,VECT *rp)

VECT w;

Q c;

VECT *rp;

{

int n,i;

VECT r;

Line 2543 VECT *rp;

Line 2484 VECT *rp;

MKVECT(r,n); *rp = r;

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

mulq((Q)BDY(w)[i],(Q)c,(Q *)&BDY(r)[i]);

}

void dptoca(DP p,unsigned int **rp)

{

int i;

MP m;

unsigned int *r;

if ( !p )

*rp = 0;

else {

for ( m = BDY(p), i = 0; m; m = NEXT(m), i++ );

*rp = r = (unsigned int *)MALLOC_ATOMIC(i*sizeof(unsigned int));

for ( m = BDY(p), i = 0; m; m = NEXT(m), i++ )

r[i] = ITOS(C(m));

}

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