version 1.193, 2010/12/22 09:33:57 |
version 1.205, 2013/09/09 09:47:09 |
|
|
/* $OpenXM: OpenXM_contrib2/asir2000/engine/nd.c,v 1.192 2010/12/14 05:29:37 noro Exp $ */ |
/* $OpenXM: OpenXM_contrib2/asir2000/engine/nd.c,v 1.204 2013/09/09 07:29:25 noro Exp $ */ |
|
|
#include "nd.h" |
#include "nd.h" |
|
|
|
struct oEGT eg_search; |
|
|
int diag_period = 6; |
int diag_period = 6; |
|
int weight_check = 1; |
int (*ndl_compare_function)(UINT *a1,UINT *a2); |
int (*ndl_compare_function)(UINT *a1,UINT *a2); |
int nd_dcomp; |
int nd_dcomp; |
NM _nm_free_list; |
NM _nm_free_list; |
Line 49 static int nd_demand; |
|
Line 52 static int nd_demand; |
|
static int nd_module,nd_ispot,nd_mpos,nd_pot_nelim; |
static int nd_module,nd_ispot,nd_mpos,nd_pot_nelim; |
static NODE nd_tracelist; |
static NODE nd_tracelist; |
static NODE nd_alltracelist; |
static NODE nd_alltracelist; |
static int nd_gentrace,nd_gensyz,nd_nora,nd_newelim; |
static int nd_gentrace,nd_gensyz,nd_nora,nd_newelim,nd_intersect; |
static int *nd_gbblock; |
static int *nd_gbblock; |
|
|
NumberField get_numberfield(); |
NumberField get_numberfield(); |
Line 62 LIST ndvtopl(int mod,VL vl,VL dvl,NDV p,int rank); |
|
Line 65 LIST ndvtopl(int mod,VL vl,VL dvl,NDV p,int rank); |
|
NDV pltondv(VL vl,VL dvl,LIST p); |
NDV pltondv(VL vl,VL dvl,LIST p); |
void pltozpl(LIST l,Q *cont,LIST *pp); |
void pltozpl(LIST l,Q *cont,LIST *pp); |
void ndl_max(UINT *d1,unsigned *d2,UINT *d); |
void ndl_max(UINT *d1,unsigned *d2,UINT *d); |
pointer GC_malloc_atomic_ignore_off_page(int); |
|
void nmtodp(int mod,NM m,DP *r); |
void nmtodp(int mod,NM m,DP *r); |
NODE reverse_node(NODE n); |
NODE reverse_node(NODE n); |
P ndc_div(int mod,union oNDC a,union oNDC b); |
P ndc_div(int mod,union oNDC a,union oNDC b); |
Line 70 P ndctop(int mod,union oNDC c); |
|
Line 72 P ndctop(int mod,union oNDC c); |
|
void finalize_tracelist(int i,P cont); |
void finalize_tracelist(int i,P cont); |
void conv_ilist(int demand,int trace,NODE g,int **indp); |
void conv_ilist(int demand,int trace,NODE g,int **indp); |
void parse_nd_option(NODE opt); |
void parse_nd_option(NODE opt); |
|
void dltondl(int n,DL dl,UINT *r); |
|
DP ndvtodp(int mod,NDV p); |
|
DP ndtodp(int mod,ND p); |
|
|
extern int Denominator,DP_Multiple; |
extern int Denominator,DP_Multiple; |
|
|
|
|
int i; |
int i; |
|
|
for ( i = 0; i < 1024; i++ ) { |
for ( i = 0; i < 1024; i++ ) { |
p = (NM)GC_malloc(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT)); |
p = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT)); |
p->next = _nm_free_list; _nm_free_list = p; |
p->next = _nm_free_list; _nm_free_list = p; |
} |
} |
} |
} |
|
Line 104 void _ND_alloc() |
|
int i; |
int i; |
|
|
for ( i = 0; i < 1024; i++ ) { |
for ( i = 0; i < 1024; i++ ) { |
p = (ND)GC_malloc(sizeof(struct oND)); |
p = (ND)MALLOC(sizeof(struct oND)); |
p->body = (NM)_nd_free_list; _nd_free_list = p; |
p->body = (NM)_nd_free_list; _nd_free_list = p; |
} |
} |
} |
} |
Line 110 void _NDP_alloc() |
|
Line 115 void _NDP_alloc() |
|
int i; |
int i; |
|
|
for ( i = 0; i < 1024; i++ ) { |
for ( i = 0; i < 1024; i++ ) { |
p = (ND_pairs)GC_malloc(sizeof(struct oND_pairs) |
p = (ND_pairs)MALLOC(sizeof(struct oND_pairs) |
+(nd_wpd-1)*sizeof(UINT)); |
+(nd_wpd-1)*sizeof(UINT)); |
p->next = _ndp_free_list; _ndp_free_list = p; |
p->next = _ndp_free_list; _ndp_free_list = p; |
} |
} |
Line 1577 void free_pbucket(PGeoBucket b) { |
|
Line 1582 void free_pbucket(PGeoBucket b) { |
|
nd_free(b->body[i]); |
nd_free(b->body[i]); |
b->body[i] = 0; |
b->body[i] = 0; |
} |
} |
GC_free(b); |
GCFREE(b); |
} |
} |
|
|
void add_pbucket_symbolic(PGeoBucket g,ND d) |
void add_pbucket_symbolic(PGeoBucket g,ND d) |
|
|
if ( nd_gentrace ) { |
if ( nd_gentrace ) { |
cont = ndc_div(m,hc,HCU(nf)); |
cont = ndc_div(m,hc,HCU(nf)); |
if ( m || !UNIQ(cont) ) { |
if ( m || !UNIQ(cont) ) { |
t = mknode(4,0,0,0,cont); |
t = mknode(4,NULLP,NULLP,NULLP,cont); |
MKLIST(list,t); MKNODE(t,list,nd_tracelist); |
MKLIST(list,t); MKNODE(t,list,nd_tracelist); |
nd_tracelist = t; |
nd_tracelist = t; |
} |
} |
|
|
if ( nd_gentrace ) { |
if ( nd_gentrace ) { |
cont = ndc_div(0,hnfq,HCU(nfqv)); |
cont = ndc_div(0,hnfq,HCU(nfqv)); |
if ( !UNIQ(cont) ) { |
if ( !UNIQ(cont) ) { |
t = mknode(4,0,0,0,cont); |
t = mknode(4,NULLP,NULLP,NULLP,cont); |
MKLIST(list,t); MKNODE(t,list,nd_tracelist); |
MKLIST(list,t); MKNODE(t,list,nd_tracelist); |
nd_tracelist = t; |
nd_tracelist = t; |
} |
} |
Line 2311 ND_pairs nd_newpairs( NODE g, int t ) |
|
Line 2316 ND_pairs nd_newpairs( NODE g, int t ) |
|
|
|
dl = DL(nd_psh[t]); |
dl = DL(nd_psh[t]); |
ts = SG(nd_psh[t]) - TD(dl); |
ts = SG(nd_psh[t]) - TD(dl); |
|
if ( nd_module && nd_intersect && (MPOS(dl) > 1) ) return 0; |
for ( r0 = 0, h = g; h; h = NEXT(h) ) { |
for ( r0 = 0, h = g; h; h = NEXT(h) ) { |
if ( nd_module && (MPOS(DL(nd_psh[(long)BDY(h)])) != MPOS(dl)) ) |
if ( nd_module && (MPOS(DL(nd_psh[(long)BDY(h)])) != MPOS(dl)) ) |
continue; |
continue; |
Line 2802 NODE postprocess_algcoef(VL av,NODE alist,NODE r) |
|
Line 2808 NODE postprocess_algcoef(VL av,NODE alist,NODE r) |
|
return u0; |
return u0; |
} |
} |
|
|
void nd_gr(LIST f,LIST v,int m,int homo,int f4,struct order_spec *ord,LIST *rp) |
void nd_gr(LIST f,LIST v,int m,int homo,int retdp,int f4,struct order_spec *ord,LIST *rp) |
{ |
{ |
VL tv,fv,vv,vc,av; |
VL tv,fv,vv,vc,av; |
NODE fd,fd0,r,r0,t,x,s,xx,alist; |
NODE fd,fd0,r,r0,t,x,s,xx,alist; |
Line 2820 void nd_gr(LIST f,LIST v,int m,int homo,int f4,struct |
|
Line 2826 void nd_gr(LIST f,LIST v,int m,int homo,int f4,struct |
|
NODE tr,tl1,tl2,tl3,tl4; |
NODE tr,tl1,tl2,tl3,tl4; |
LIST l1,l2,l3,l4,l5; |
LIST l1,l2,l3,l4,l5; |
int j; |
int j; |
Q jq; |
Q jq,bpe; |
int *perm; |
int *perm; |
EPOS oepos; |
EPOS oepos; |
int obpe,oadv,ompos; |
int obpe,oadv,ompos,cbpe; |
|
|
nd_module = 0; |
nd_module = 0; |
if ( !m && Demand ) nd_demand = 1; |
if ( !m && Demand ) nd_demand = 1; |
Line 2925 void nd_gr(LIST f,LIST v,int m,int homo,int f4,struct |
|
Line 2931 void nd_gr(LIST f,LIST v,int m,int homo,int f4,struct |
|
nd_setup_parameters(nvar,0); |
nd_setup_parameters(nvar,0); |
} |
} |
nd_demand = 0; |
nd_demand = 0; |
|
if ( nd_module && nd_intersect ) { |
|
for ( j = nd_psn-1, x = 0; j >= 0; j-- ) |
|
if ( MPOS(DL(nd_psh[j])) > 1 ) { |
|
MKNODE(xx,(pointer)j,x); x = xx; |
|
} |
|
conv_ilist(nd_demand,0,x,0); |
|
goto FINAL; |
|
} |
x = ndv_reducebase(x,perm); |
x = ndv_reducebase(x,perm); |
if ( nd_gentrace ) { tl1 = nd_alltracelist; nd_alltracelist = 0; } |
if ( nd_gentrace ) { tl1 = nd_alltracelist; nd_alltracelist = 0; } |
x = ndv_reduceall(m,x); |
x = ndv_reduceall(m,x); |
|
cbpe = nd_bpe; |
if ( nd_gentrace ) { |
if ( nd_gentrace ) { |
tl2 = nd_alltracelist; nd_alltracelist = 0; |
tl2 = nd_alltracelist; nd_alltracelist = 0; |
ndv_check_membership(m,fd0,obpe,oadv,oepos,x); |
ndv_check_membership(m,fd0,obpe,oadv,oepos,x); |
if ( nd_gentrace ) { |
tl3 = nd_alltracelist; nd_alltracelist = 0; |
tl3 = nd_alltracelist; nd_alltracelist = 0; |
if ( nd_gensyz ) { |
} else tl3 = 0; |
nd_gb(m,0,1,1,0); |
nd_gb(m,0,1,nd_gensyz?1:0,0)!=0; |
|
if ( nd_gentrace && nd_gensyz ) { |
|
tl4 = nd_alltracelist; nd_alltracelist = 0; |
tl4 = nd_alltracelist; nd_alltracelist = 0; |
} else tl4 = 0; |
} else tl4 = 0; |
} |
} |
|
nd_bpe = cbpe; |
|
nd_setup_parameters(nd_nvar,0); |
|
FINAL: |
for ( r0 = 0, t = x; t; t = NEXT(t) ) { |
for ( r0 = 0, t = x; t; t = NEXT(t) ) { |
NEXTNODE(r0,r); |
NEXTNODE(r0,r); |
if ( nd_module ) BDY(r) = ndvtopl(m,CO,vv,BDY(t),mrank); |
if ( nd_module ) BDY(r) = ndvtopl(m,CO,vv,BDY(t),mrank); |
else BDY(r) = ndvtop(m,CO,vv,BDY(t)); |
else if ( retdp ) BDY(r) = ndvtodp(m,BDY(t)); |
|
else BDY(r) = ndvtop(m,CO,vv,BDY(t)); |
} |
} |
if ( r0 ) NEXT(r) = 0; |
if ( r0 ) NEXT(r) = 0; |
if ( nalg ) |
if ( nalg ) |
Line 2964 void nd_gr(LIST f,LIST v,int m,int homo,int f4,struct |
|
Line 2981 void nd_gr(LIST f,LIST v,int m,int homo,int f4,struct |
|
for ( j = length(x)-1, t = 0; j >= 0; j-- ) { |
for ( j = length(x)-1, t = 0; j >= 0; j-- ) { |
STOQ(perm[j],jq); MKNODE(s,jq,t); t = s; |
STOQ(perm[j],jq); MKNODE(s,jq,t); t = s; |
} |
} |
MKLIST(l1,tl1); MKLIST(l2,tl2); MKLIST(l3,t); MKLIST(l4,tl3); |
MKLIST(l1,tl1); MKLIST(l2,tl2); MKLIST(l3,t); MKLIST(l4,tl3); |
MKLIST(l5,tl4); |
MKLIST(l5,tl4); |
tr = mknode(7,*rp,(!ishomo&&homo)?ONE:0,l1,l2,l3,l4,l5); MKLIST(*rp,tr); |
STOQ(nd_bpe,bpe); |
|
tr = mknode(8,*rp,(!ishomo&&homo)?ONE:0,l1,l2,l3,l4,l5,bpe); MKLIST(*rp,tr); |
} |
} |
#if 0 |
#if 0 |
fprintf(asir_out,"ndv_alloc=%d\n",ndv_alloc); |
fprintf(asir_out,"ndv_alloc=%d\n",ndv_alloc); |
Line 2989 void nd_gr_postproc(LIST f,LIST v,int m,struct order_s |
|
Line 3007 void nd_gr_postproc(LIST f,LIST v,int m,struct order_s |
|
struct order_spec *ord1; |
struct order_spec *ord1; |
int *perm; |
int *perm; |
|
|
|
parse_nd_option(current_option); |
get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc); |
get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc); |
for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ ); |
for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ ); |
switch ( ord->id ) { |
switch ( ord->id ) { |
Line 3061 void nd_gr_postproc(LIST f,LIST v,int m,struct order_s |
|
Line 3080 void nd_gr_postproc(LIST f,LIST v,int m,struct order_s |
|
MKLIST(*rp,r0); |
MKLIST(*rp,r0); |
} |
} |
|
|
|
#if 0 |
|
NDV recompute_trace(NODE trace,NDV *p,int m); |
|
void nd_gr_recompute_trace(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,LIST *rp); |
|
|
|
NDV recompute_trace(NODE ti,NDV *p,int mod) |
|
{ |
|
int c,c1,c2,i; |
|
NM mul,m,tail; |
|
ND d,r,rm; |
|
NODE sj; |
|
NDV red; |
|
Obj mj; |
|
static int afo=0; |
|
|
|
afo++; |
|
mul = (NM)ALLOCA(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT)); |
|
CM(mul) = 1; |
|
tail = 0; |
|
for ( i = 0, d = r = 0; ti; ti = NEXT(ti), i++ ) { |
|
sj = BDY((LIST)BDY(ti)); |
|
if ( ARG0(sj) ) { |
|
red = p[QTOS((Q)ARG1(sj))]; |
|
mj = (Obj)ARG2(sj); |
|
if ( OID(mj) != O_DP ) ndl_zero(DL(mul)); |
|
else dltondl(nd_nvar,BDY((DP)mj)->dl,DL(mul)); |
|
rm = ndv_mul_nm(mod,mul,red); |
|
if ( !r ) r = rm; |
|
else { |
|
for ( m = BDY(r); m && !ndl_equal(m->dl,BDY(rm)->dl); m = NEXT(m), LEN(r)-- ) { |
|
if ( d ) { |
|
NEXT(tail) = m; tail = m; LEN(d)++; |
|
} else { |
|
MKND(nd_nvar,m,1,d); tail = BDY(d); |
|
} |
|
} |
|
if ( !m ) return 0; /* failure */ |
|
else { |
|
BDY(r) = m; |
|
c1 = invm(HCM(rm),mod); c2 = mod-HCM(r); |
|
DMAR(c1,c2,0,mod,c); |
|
nd_mul_c(mod,rm,c); |
|
r = nd_add(mod,r,rm); |
|
} |
|
} |
|
} |
|
} |
|
if ( tail ) NEXT(tail) = 0; |
|
d = nd_add(mod,d,r); |
|
nd_mul_c(mod,d,invm(HCM(d),mod)); |
|
return ndtondv(mod,d); |
|
} |
|
|
|
void nd_gr_recompute_trace(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,LIST *rp) |
|
{ |
|
VL tv,fv,vv,vc,av; |
|
NODE fd,fd0,r,r0,t,x,s,xx,alist; |
|
int e,max,nvar,i; |
|
NDV b; |
|
int ishomo,nalg; |
|
Alg alpha,dp; |
|
P p,zp; |
|
Q dmy; |
|
LIST f1,f2; |
|
Obj obj; |
|
NumberField nf; |
|
struct order_spec *ord1; |
|
NODE permtrace,intred,ind,perm,trace,ti; |
|
int len,n,j; |
|
NDV *db,*pb; |
|
|
|
parse_nd_option(current_option); |
|
get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc); |
|
for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ ); |
|
switch ( ord->id ) { |
|
case 1: |
|
if ( ord->nv != nvar ) |
|
error("nd_check : invalid order specification"); |
|
break; |
|
default: |
|
break; |
|
} |
|
nd_init_ord(ord); |
|
nd_bpe = QTOS((Q)ARG7(BDY(tlist))); |
|
nd_setup_parameters(nvar,0); |
|
|
|
len = length(BDY(f)); |
|
db = (NDV *)MALLOC(len*sizeof(NDV *)); |
|
for ( i = 0, t = BDY(f); t; i++, t = NEXT(t) ) { |
|
ptozp((P)BDY(t),1,&dmy,&zp); |
|
b = ptondv(CO,vv,zp); |
|
ndv_mod(m,b); |
|
ndv_mul_c(m,b,invm(HCM(b),m)); |
|
db[i] = b; |
|
} |
|
|
|
permtrace = BDY((LIST)ARG2(BDY(tlist))); |
|
intred = BDY((LIST)ARG3(BDY(tlist))); |
|
ind = BDY((LIST)ARG4(BDY(tlist))); |
|
perm = BDY((LIST)ARG0(permtrace)); |
|
trace = NEXT(permtrace); |
|
|
|
for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) { |
|
j = QTOS((Q)ARG0(BDY((LIST)BDY(t)))); |
|
if ( j > i ) i = j; |
|
} |
|
n = i+1; |
|
pb = (NDV *)MALLOC(n*sizeof(NDV *)); |
|
for ( t = perm, i = 0; t; t = NEXT(t), i++ ) { |
|
ti = BDY((LIST)BDY(t)); |
|
pb[QTOS((Q)ARG0(ti))] = db[QTOS((Q)ARG1(ti))]; |
|
} |
|
for ( t = trace; t; t = NEXT(t) ) { |
|
ti = BDY((LIST)BDY(t)); |
|
pb[QTOS((Q)ARG0(ti))] = recompute_trace(BDY((LIST)ARG1(ti)),pb,m); |
|
if ( !pb[QTOS((Q)ARG0(ti))] ) { *rp = 0; return; } |
|
if ( DP_Print ) { |
|
fprintf(asir_out,"."); fflush(asir_out); |
|
} |
|
} |
|
for ( t = intred; t; t = NEXT(t) ) { |
|
ti = BDY((LIST)BDY(t)); |
|
pb[QTOS((Q)ARG0(ti))] = recompute_trace(BDY((LIST)ARG1(ti)),pb,m); |
|
if ( !pb[QTOS((Q)ARG0(ti))] ) { *rp = 0; return; } |
|
if ( DP_Print ) { |
|
fprintf(asir_out,"*"); fflush(asir_out); |
|
} |
|
} |
|
for ( r0 = 0, t = ind; t; t = NEXT(t) ) { |
|
NEXTNODE(r0,r); |
|
b = pb[QTOS((Q)BDY(t))]; |
|
ndv_mul_c(m,b,invm(HCM(b),m)); |
|
#if 0 |
|
BDY(r) = ndvtop(m,CO,vv,pb[QTOS((Q)BDY(t))]); |
|
#else |
|
BDY(r) = ndvtodp(m,pb[QTOS((Q)BDY(t))]); |
|
#endif |
|
} |
|
if ( r0 ) NEXT(r) = 0; |
|
MKLIST(*rp,r0); |
|
if ( DP_Print ) fprintf(asir_out,"\n"); |
|
} |
|
#endif |
|
|
void nd_gr_trace(LIST f,LIST v,int trace,int homo,int f4,struct order_spec *ord,LIST *rp) |
void nd_gr_trace(LIST f,LIST v,int trace,int homo,int f4,struct order_spec *ord,LIST *rp) |
{ |
{ |
VL tv,fv,vv,vc,av; |
VL tv,fv,vv,vc,av; |
Line 3083 void nd_gr_trace(LIST f,LIST v,int trace,int homo,int |
|
Line 3245 void nd_gr_trace(LIST f,LIST v,int trace,int homo,int |
|
LIST l1,l2,l3,l4,l5; |
LIST l1,l2,l3,l4,l5; |
int *perm; |
int *perm; |
int j,ret; |
int j,ret; |
Q jq; |
Q jq,bpe; |
|
|
nd_module = 0; |
nd_module = 0; |
parse_nd_option(current_option); |
parse_nd_option(current_option); |
Line 3265 void nd_gr_trace(LIST f,LIST v,int trace,int homo,int |
|
Line 3427 void nd_gr_trace(LIST f,LIST v,int trace,int homo,int |
|
} |
} |
MKLIST(l1,tl1); MKLIST(l2,tl2); MKLIST(l3,t); MKLIST(l4,tl3); |
MKLIST(l1,tl1); MKLIST(l2,tl2); MKLIST(l3,t); MKLIST(l4,tl3); |
MKLIST(l5,tl4); |
MKLIST(l5,tl4); |
tr = mknode(7,*rp,(!ishomo&&homo)?ONE:0,l1,l2,l3,l4,l5); MKLIST(*rp,tr); |
STOQ(nd_bpe,bpe); |
|
tr = mknode(8,*rp,(!ishomo&&homo)?ONE:0,l1,l2,l3,l4,l5,bpe); MKLIST(*rp,tr); |
} |
} |
} |
} |
|
|
Line 3682 void nd_free(ND p) |
|
Line 3845 void nd_free(ND p) |
|
|
|
void ndv_free(NDV p) |
void ndv_free(NDV p) |
{ |
{ |
GC_free(BDY(p)); |
GCFREE(BDY(p)); |
} |
} |
|
|
void nd_append_red(UINT *d,int i) |
void nd_append_red(UINT *d,int i) |
Line 3793 void nd_setup_parameters(int nvar,int max) { |
|
Line 3956 void nd_setup_parameters(int nvar,int max) { |
|
else if ( max < 65536 ) nd_bpe = 16; |
else if ( max < 65536 ) nd_bpe = 16; |
else nd_bpe = 32; |
else nd_bpe = 32; |
} |
} |
|
if ( !do_weyl && weight_check && (current_dl_weight_vector || nd_matrix) ) { |
|
UINT t; |
|
int st; |
|
int *v; |
|
/* t = max(weights) */ |
|
t = 0; |
|
if ( current_dl_weight_vector ) |
|
for ( i = 0, t = 0; i < nd_nvar; i++ ) { |
|
if ( (st=current_dl_weight_vector[i]) < 0 ) st = -st; |
|
if ( t < st ) t = st; |
|
} |
|
if ( nd_matrix ) |
|
for ( i = 0; i < nd_matrix_len; i++ ) |
|
for ( j = 0, v = nd_matrix[i]; j < nd_nvar; j++ ) { |
|
if ( (st=v[j]) < 0 ) st = -st; |
|
if ( t < st ) t = st; |
|
} |
|
/* i = bitsize of t */ |
|
for ( i = 0; t; t >>=1, i++ ); |
|
/* i += bitsize of nd_nvar */ |
|
for ( t = nd_nvar; t; t >>=1, i++); |
|
/* nd_bpe+i = bitsize of max(weights)*max(exp)*nd_nvar */ |
|
if ( (nd_bpe+i) >= 31 ) |
|
error("nd_setup_parameters : too large weight"); |
|
} |
nd_epw = (sizeof(UINT)*8)/nd_bpe; |
nd_epw = (sizeof(UINT)*8)/nd_bpe; |
elen = nd_nvar/nd_epw+(nd_nvar%nd_epw?1:0); |
elen = nd_nvar/nd_epw+(nd_nvar%nd_epw?1:0); |
nd_exporigin = nd_get_exporigin(nd_ord); |
nd_exporigin = nd_get_exporigin(nd_ord); |
Line 4647 NDV ndtondv(int mod,ND p) |
|
Line 4835 NDV ndtondv(int mod,ND p) |
|
if ( !p ) return 0; |
if ( !p ) return 0; |
len = LEN(p); |
len = LEN(p); |
if ( mod ) |
if ( mod ) |
m0 = m = (NMV)GC_malloc_atomic_ignore_off_page(len*nmv_adv); |
m0 = m = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(len*nmv_adv); |
else |
else |
m0 = m = MALLOC(len*nmv_adv); |
m0 = m = MALLOC(len*nmv_adv); |
#if 0 |
#if 0 |
Line 4683 ND ndvtond(int mod,NDV p) |
|
Line 4871 ND ndvtond(int mod,NDV p) |
|
return d; |
return d; |
} |
} |
|
|
|
DP ndvtodp(int mod,NDV p) |
|
{ |
|
MP m,m0; |
|
DP d; |
|
NMV t; |
|
int i,len; |
|
|
|
if ( !p ) return 0; |
|
m0 = 0; |
|
len = p->len; |
|
for ( t = BDY(p), i = 0; i < len; NMV_ADV(t), i++ ) { |
|
NEXTMP(m0,m); |
|
m->dl = ndltodl(nd_nvar,DL(t)); |
|
m->c = ndctop(mod,t->c); |
|
} |
|
NEXT(m) = 0; |
|
MKDP(nd_nvar,m0,d); |
|
SG(d) = SG(p); |
|
return d; |
|
} |
|
|
|
DP ndtodp(int mod,ND p) |
|
{ |
|
MP m,m0; |
|
DP d; |
|
NM t; |
|
int i,len; |
|
|
|
if ( !p ) return 0; |
|
m0 = 0; |
|
len = p->len; |
|
for ( t = BDY(p); t; t = NEXT(t) ) { |
|
NEXTMP(m0,m); |
|
m->dl = ndltodl(nd_nvar,DL(t)); |
|
m->c = ndctop(mod,t->c); |
|
} |
|
NEXT(m) = 0; |
|
MKDP(nd_nvar,m0,d); |
|
SG(d) = SG(p); |
|
return d; |
|
} |
|
|
void ndv_print(NDV p) |
void ndv_print(NDV p) |
{ |
{ |
NMV m; |
NMV m; |
Line 4751 NODE ndv_reducebase(NODE x,int *perm) |
|
Line 4981 NODE ndv_reducebase(NODE x,int *perm) |
|
void nd_init_ord(struct order_spec *ord) |
void nd_init_ord(struct order_spec *ord) |
{ |
{ |
nd_module = (ord->id >= 256); |
nd_module = (ord->id >= 256); |
|
nd_matrix = 0; |
|
nd_matrix_len = 0; |
switch ( ord->id ) { |
switch ( ord->id ) { |
case 0: |
case 0: |
switch ( ord->ord.simple ) { |
switch ( ord->ord.simple ) { |
Line 5065 IndArray nm_ind_pair_to_vect_compress(int mod,UINT *s0 |
|
Line 5297 IndArray nm_ind_pair_to_vect_compress(int mod,UINT *s0 |
|
UINT *v,*ivi,*s0v; |
UINT *v,*ivi,*s0v; |
int i,j,len,prev,diff,cdiff; |
int i,j,len,prev,diff,cdiff; |
IndArray r; |
IndArray r; |
|
struct oEGT eg0,eg1; |
|
|
m = pair->mul; |
m = pair->mul; |
d = DL(m); |
d = DL(m); |
Line 5072 IndArray nm_ind_pair_to_vect_compress(int mod,UINT *s0 |
|
Line 5305 IndArray nm_ind_pair_to_vect_compress(int mod,UINT *s0 |
|
len = LEN(p); |
len = LEN(p); |
t = (UINT *)ALLOCA(nd_wpd*sizeof(UINT)); |
t = (UINT *)ALLOCA(nd_wpd*sizeof(UINT)); |
v = (unsigned int *)ALLOCA(len*sizeof(unsigned int)); |
v = (unsigned int *)ALLOCA(len*sizeof(unsigned int)); |
|
get_eg(&eg0); |
for ( i = j = 0, s = s0, mr = BDY(p); j < len; j++, NMV_ADV(mr) ) { |
for ( i = j = 0, s = s0, mr = BDY(p); j < len; j++, NMV_ADV(mr) ) { |
ndl_add(d,DL(mr),t); |
ndl_add(d,DL(mr),t); |
for ( ; !ndl_equal(t,s); s += nd_wpd, i++ ); |
for ( ; !ndl_equal(t,s); s += nd_wpd, i++ ); |
v[j] = i; |
v[j] = i; |
} |
} |
|
get_eg(&eg1); add_eg(&eg_search,&eg0,&eg1); |
r = (IndArray)MALLOC(sizeof(struct oIndArray)); |
r = (IndArray)MALLOC(sizeof(struct oIndArray)); |
r->head = v[0]; |
r->head = v[0]; |
diff = 0; |
diff = 0; |
Line 5318 NDV vect_to_ndv(UINT *vect,int spcol,int col,int *rhea |
|
Line 5553 NDV vect_to_ndv(UINT *vect,int spcol,int col,int *rhea |
|
for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++; |
for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++; |
if ( !len ) return 0; |
if ( !len ) return 0; |
else { |
else { |
mr0 = (NMV)GC_malloc_atomic_ignore_off_page(nmv_adv*len); |
mr0 = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len); |
#if 0 |
#if 0 |
ndv_alloc += nmv_adv*len; |
ndv_alloc += nmv_adv*len; |
#endif |
#endif |
Line 5348 NDV vect_to_ndv_q(Q *vect,int spcol,int col,int *rhead |
|
Line 5583 NDV vect_to_ndv_q(Q *vect,int spcol,int col,int *rhead |
|
for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++; |
for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++; |
if ( !len ) return 0; |
if ( !len ) return 0; |
else { |
else { |
mr0 = (NMV)GC_malloc(nmv_adv*len); |
mr0 = (NMV)MALLOC(nmv_adv*len); |
#if 0 |
#if 0 |
ndv_alloc += nmv_adv*len; |
ndv_alloc += nmv_adv*len; |
#endif |
#endif |
Line 5380 NDV plain_vect_to_ndv_q(Q *vect,int col,UINT *s0vect) |
|
Line 5615 NDV plain_vect_to_ndv_q(Q *vect,int col,UINT *s0vect) |
|
for ( j = 0, len = 0; j < col; j++ ) if ( vect[j] ) len++; |
for ( j = 0, len = 0; j < col; j++ ) if ( vect[j] ) len++; |
if ( !len ) return 0; |
if ( !len ) return 0; |
else { |
else { |
mr0 = (NMV)GC_malloc(nmv_adv*len); |
mr0 = (NMV)MALLOC(nmv_adv*len); |
#if 0 |
#if 0 |
ndv_alloc += nmv_adv*len; |
ndv_alloc += nmv_adv*len; |
#endif |
#endif |
Line 5457 int nd_symbolic_preproc(PGeoBucket bucket,int trace,UI |
|
Line 5692 int nd_symbolic_preproc(PGeoBucket bucket,int trace,UI |
|
return col; |
return col; |
} |
} |
|
|
|
|
NODE nd_f4(int m,int **indp) |
NODE nd_f4(int m,int **indp) |
{ |
{ |
int i,nh,stat,index; |
int i,nh,stat,index; |
Line 5749 NODE nd_f4_red(int m,ND_pairs sp0,int trace,UINT *s0ve |
|
Line 5985 NODE nd_f4_red(int m,ND_pairs sp0,int trace,UINT *s0ve |
|
NODE r0,rp; |
NODE r0,rp; |
ND_pairs sp; |
ND_pairs sp; |
NM_ind_pair *rvect; |
NM_ind_pair *rvect; |
|
init_eg(&eg_search); |
for ( sp = sp0, nsp = 0; sp; sp = NEXT(sp), nsp++ ); |
for ( sp = sp0, nsp = 0; sp; sp = NEXT(sp), nsp++ ); |
nred = length(rp0); |
nred = length(rp0); |
imat = (IndArray *)ALLOCA(nred*sizeof(IndArray)); |
imat = (IndArray *)ALLOCA(nred*sizeof(IndArray)); |
Line 5767 NODE nd_f4_red(int m,ND_pairs sp0,int trace,UINT *s0ve |
|
Line 6003 NODE nd_f4_red(int m,ND_pairs sp0,int trace,UINT *s0ve |
|
r0 = nd_f4_red_main(m,sp0,nsp,s0vect,col,rvect,rhead,imat,nred,nz); |
r0 = nd_f4_red_main(m,sp0,nsp,s0vect,col,rvect,rhead,imat,nred,nz); |
else |
else |
r0 = nd_f4_red_q_main(sp0,nsp,trace,s0vect,col,rvect,rhead,imat,nred); |
r0 = nd_f4_red_q_main(sp0,nsp,trace,s0vect,col,rvect,rhead,imat,nred); |
|
print_eg("search",&eg_search); |
return r0; |
return r0; |
} |
} |
|
|
Line 5819 NODE nd_f4_red_main(int m,ND_pairs sp0,int nsp,UINT *s |
|
Line 6056 NODE nd_f4_red_main(int m,ND_pairs sp0,int nsp,UINT *s |
|
fflush(asir_out); |
fflush(asir_out); |
} |
} |
/* free index arrays */ |
/* free index arrays */ |
for ( i = 0; i < nred; i++ ) GC_free(imat[i]->index.c); |
for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c); |
|
|
/* elimination (2nd step) */ |
/* elimination (2nd step) */ |
colstat = (int *)ALLOCA(spcol*sizeof(int)); |
colstat = (int *)ALLOCA(spcol*sizeof(int)); |
Line 5832 NODE nd_f4_red_main(int m,ND_pairs sp0,int nsp,UINT *s |
|
Line 6069 NODE nd_f4_red_main(int m,ND_pairs sp0,int nsp,UINT *s |
|
NEXTNODE(r0,r); BDY(r) = |
NEXTNODE(r0,r); BDY(r) = |
(pointer)vect_to_ndv(spmat[i],spcol,col,rhead,s0vect); |
(pointer)vect_to_ndv(spmat[i],spcol,col,rhead,s0vect); |
SG((NDV)BDY(r)) = spsugar[i]; |
SG((NDV)BDY(r)) = spsugar[i]; |
GC_free(spmat[i]); |
GCFREE(spmat[i]); |
} |
} |
if ( r0 ) NEXT(r) = 0; |
if ( r0 ) NEXT(r) = 0; |
|
|
for ( ; i < sprow; i++ ) GC_free(spmat[i]); |
for ( ; i < sprow; i++ ) GCFREE(spmat[i]); |
get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2); |
get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2); |
init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2); |
init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2); |
if ( DP_Print ) { |
if ( DP_Print ) { |
Line 5900 NODE nd_f4_red_q_main(ND_pairs sp0,int nsp,int trace,U |
|
Line 6137 NODE nd_f4_red_q_main(ND_pairs sp0,int nsp,int trace,U |
|
fflush(asir_out); |
fflush(asir_out); |
} |
} |
/* free index arrays */ |
/* free index arrays */ |
/* for ( i = 0; i < nred; i++ ) GC_free(imat[i]->index.c); */ |
/* for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c); */ |
|
|
/* elimination (2nd step) */ |
/* elimination (2nd step) */ |
colstat = (int *)ALLOCA(spcol*sizeof(int)); |
colstat = (int *)ALLOCA(spcol*sizeof(int)); |
Line 5909 NODE nd_f4_red_q_main(ND_pairs sp0,int nsp,int trace,U |
|
Line 6146 NODE nd_f4_red_q_main(ND_pairs sp0,int nsp,int trace,U |
|
for ( i = 0; i < rank; i++ ) { |
for ( i = 0; i < rank; i++ ) { |
w[rank-i-1] = (pointer)vect_to_ndv_q(spmat[i],spcol,col,rhead,s0vect); |
w[rank-i-1] = (pointer)vect_to_ndv_q(spmat[i],spcol,col,rhead,s0vect); |
SG((NDV)w[rank-i-1]) = spsugar[i]; |
SG((NDV)w[rank-i-1]) = spsugar[i]; |
/* GC_free(spmat[i]); */ |
/* GCFREE(spmat[i]); */ |
} |
} |
#if 0 |
#if 0 |
qsort(w,rank,sizeof(NDV), |
qsort(w,rank,sizeof(NDV), |
Line 5921 NODE nd_f4_red_q_main(ND_pairs sp0,int nsp,int trace,U |
|
Line 6158 NODE nd_f4_red_q_main(ND_pairs sp0,int nsp,int trace,U |
|
} |
} |
if ( r0 ) NEXT(r) = 0; |
if ( r0 ) NEXT(r) = 0; |
|
|
/* for ( ; i < sprow; i++ ) GC_free(spmat[i]); */ |
/* for ( ; i < sprow; i++ ) GCFREE(spmat[i]); */ |
get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2); |
get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2); |
init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2); |
init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2); |
if ( DP_Print ) { |
if ( DP_Print ) { |
Line 6053 NDV nd_recv_ndv() |
|
Line 6290 NDV nd_recv_ndv() |
|
len = nd_recv_int(); |
len = nd_recv_int(); |
if ( !len ) return 0; |
if ( !len ) return 0; |
else { |
else { |
m0 = m = (NMV)GC_malloc_atomic_ignore_off_page(nmv_adv*len); |
m0 = m = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len); |
#if 0 |
#if 0 |
ndv_alloc += len*nmv_adv; |
ndv_alloc += len*nmv_adv; |
#endif |
#endif |
Line 6920 void finalize_tracelist(int i,P cont) |
|
Line 7157 void finalize_tracelist(int i,P cont) |
|
Q iq; |
Q iq; |
|
|
if ( !UNIQ(cont) ) { |
if ( !UNIQ(cont) ) { |
node = mknode(4,0,0,0,cont); |
node = mknode(4,NULLP,NULLP,NULLP,cont); |
MKLIST(l,node); MKNODE(node,l,nd_tracelist); |
MKLIST(l,node); MKNODE(node,l,nd_tracelist); |
nd_tracelist = node; |
nd_tracelist = node; |
} |
} |
Line 6955 void parse_nd_option(NODE opt) |
|
Line 7192 void parse_nd_option(NODE opt) |
|
Obj value; |
Obj value; |
|
|
nd_gentrace = 0; nd_gensyz = 0; nd_nora = 0; nd_gbblock = 0; |
nd_gentrace = 0; nd_gensyz = 0; nd_nora = 0; nd_gbblock = 0; |
nd_newelim = 0; |
nd_newelim = 0; nd_intersect = 0; |
for ( t = opt; t; t = NEXT(t) ) { |
for ( t = opt; t; t = NEXT(t) ) { |
p = BDY((LIST)BDY(t)); |
p = BDY((LIST)BDY(t)); |
key = BDY((STRING)BDY(p)); |
key = BDY((STRING)BDY(p)); |
Line 6979 void parse_nd_option(NODE opt) |
|
Line 7216 void parse_nd_option(NODE opt) |
|
nd_gbblock[i] = -1; |
nd_gbblock[i] = -1; |
} else if ( !strcmp(key,"newelim") ) |
} else if ( !strcmp(key,"newelim") ) |
nd_newelim = value?1:0; |
nd_newelim = value?1:0; |
|
else if ( !strcmp(key,"intersect") ) |
|
nd_intersect = value?1:0; |
} |
} |
|
} |
|
|
|
ND mdptond(DP d); |
|
ND nd_mul_nm(int mod,NM m0,ND p); |
|
ND *recompute_trace(NODE ti,ND **p,int nb,int mod); |
|
ND recompute_trace_one(NODE ti,ND *p,int nb,int mod); |
|
MAT nd_btog(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,MAT *rp); |
|
VECT nd_btog_one(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,int pos,MAT *rp); |
|
|
|
/* d:monomial */ |
|
ND mdptond(DP d) |
|
{ |
|
NM m; |
|
ND r; |
|
|
|
if ( OID(d) == 1 ) |
|
r = ptond(CO,CO,(P)d); |
|
else { |
|
NEWNM(m); |
|
dltondl(NV(d),BDY(d)->dl,DL(m)); |
|
CQ(m) = (Q)BDY(d)->c; |
|
NEXT(m) = 0; |
|
MKND(NV(d),m,1,r); |
|
} |
|
return r; |
|
} |
|
|
|
ND nd_mul_nm(int mod,NM m0,ND p) |
|
{ |
|
UINT *d0; |
|
int c0,c1,c; |
|
NM tm,mr,mr0; |
|
ND r; |
|
|
|
if ( !p ) return 0; |
|
d0 = DL(m0); |
|
c0 = CM(m0); |
|
mr0 = 0; |
|
for ( tm = BDY(p); tm; tm = NEXT(tm) ) { |
|
NEXTNM(mr0,mr); |
|
c = CM(tm); DMAR(c0,c,0,mod,c1); CM(mr) = c1; |
|
ndl_add(d0,DL(tm),DL(mr)); |
|
} |
|
NEXT(mr) = 0; |
|
MKND(NV(p),mr0,LEN(p),r); |
|
return r; |
|
} |
|
|
|
ND *recompute_trace(NODE ti,ND **p,int nb,int mod) |
|
{ |
|
PGeoBucket *r; |
|
int i,ci; |
|
NODE t,s; |
|
ND m,tp; |
|
ND *pi,*rd; |
|
P c; |
|
|
|
r = (PGeoBucket *)MALLOC(nb*sizeof(PGeoBucket)); |
|
for ( i = 0; i < nb; i++ ) |
|
r[i] = create_pbucket(); |
|
for ( t = ti; t; t = NEXT(t) ) { |
|
s = BDY((LIST)BDY(t)); |
|
if ( ARG0(s) ) { |
|
m = mdptond((DP)ARG2(s)); |
|
ptomp(mod,(P)HCQ(m),&c); |
|
if ( ci = ((MQ)c)->cont ) { |
|
HCM(m) = ci; |
|
pi = p[QTOS((Q)ARG1(s))]; |
|
for ( i = 0; i < nb; i++ ) { |
|
tp = nd_mul_nm(mod,BDY(m),pi[i]); |
|
add_pbucket(mod,r[i],tp); |
|
} |
|
} |
|
ci = 1; |
|
} else { |
|
ptomp(mod,(P)ARG3(s),&c); ci = ((MQ)c)->cont; |
|
ci = invm(ci,mod); |
|
} |
|
} |
|
rd = (ND *)MALLOC(nb*sizeof(ND)); |
|
for ( i = 0; i < nb; i++ ) |
|
rd[i] = normalize_pbucket(mod,r[i]); |
|
if ( ci != 1 ) |
|
for ( i = 0; i < nb; i++ ) nd_mul_c(mod,rd[i],ci); |
|
return rd; |
|
} |
|
|
|
ND recompute_trace_one(NODE ti,ND *p,int nb,int mod) |
|
{ |
|
PGeoBucket r; |
|
int i,ci; |
|
NODE t,s; |
|
ND m,tp; |
|
ND pi,rd; |
|
P c; |
|
|
|
r = create_pbucket(); |
|
for ( t = ti; t; t = NEXT(t) ) { |
|
s = BDY((LIST)BDY(t)); |
|
if ( ARG0(s) ) { |
|
m = mdptond((DP)ARG2(s)); |
|
ptomp(mod,(P)HCQ(m),&c); |
|
if ( ci = ((MQ)c)->cont ) { |
|
HCM(m) = ci; |
|
pi = p[QTOS((Q)ARG1(s))]; |
|
tp = nd_mul_nm(mod,BDY(m),pi); |
|
add_pbucket(mod,r,tp); |
|
} |
|
ci = 1; |
|
} else { |
|
ptomp(mod,(P)ARG3(s),&c); ci = ((MQ)c)->cont; |
|
ci = invm(ci,mod); |
|
} |
|
} |
|
rd = normalize_pbucket(mod,r); |
|
if ( ci != 1 ) nd_mul_c(mod,rd,ci); |
|
return rd; |
|
} |
|
|
|
MAT nd_btog(LIST f,LIST v,int mod,struct order_spec *ord,LIST tlist,MAT *rp) |
|
{ |
|
int i,j,n,m,nb,pi0,pi1,nvar; |
|
VL fv,tv,vv; |
|
NODE permtrace,perm,trace,intred,ind,t,pi,ti; |
|
ND **p; |
|
ND *c; |
|
ND u; |
|
P inv; |
|
MAT mat; |
|
|
|
parse_nd_option(current_option); |
|
get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc); |
|
for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ ); |
|
switch ( ord->id ) { |
|
case 1: |
|
if ( ord->nv != nvar ) |
|
error("nd_check : invalid order specification"); |
|
break; |
|
default: |
|
break; |
|
} |
|
nd_init_ord(ord); |
|
#if 0 |
|
nd_bpe = QTOS((Q)ARG7(BDY(tlist))); |
|
#else |
|
nd_bpe = 32; |
|
#endif |
|
nd_setup_parameters(nvar,0); |
|
permtrace = BDY((LIST)ARG2(BDY(tlist))); |
|
intred = BDY((LIST)ARG3(BDY(tlist))); |
|
ind = BDY((LIST)ARG4(BDY(tlist))); |
|
perm = BDY((LIST)BDY(permtrace)); trace =NEXT(permtrace); |
|
for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) { |
|
j = QTOS((Q)BDY(BDY((LIST)BDY(t)))); |
|
if ( j > i ) i = j; |
|
} |
|
n = i+1; |
|
nb = length(BDY(f)); |
|
p = (ND **)MALLOC(n*sizeof(ND *)); |
|
for ( t = perm, i = 0; t; t = NEXT(t), i++ ) { |
|
pi = BDY((LIST)BDY(t)); |
|
pi0 = QTOS((Q)ARG0(pi)); pi1 = QTOS((Q)ARG1(pi)); |
|
p[pi0] = c = (ND *)MALLOC(nb*sizeof(ND)); |
|
ptomp(mod,(P)ARG2(pi),&inv); |
|
u = ptond(CO,vv,(P)ONE); |
|
HCM(u) = ((MQ)inv)->cont; |
|
c[pi1] = u; |
|
} |
|
for ( t = trace,i=0; t; t = NEXT(t), i++ ) { |
|
printf("%d ",i); fflush(stdout); |
|
ti = BDY((LIST)BDY(t)); |
|
p[j=QTOS((Q)ARG0(ti))] = recompute_trace(BDY((LIST)ARG1(ti)),p,nb,mod); |
|
if ( j == 441 ) |
|
printf("afo"); |
|
} |
|
for ( t = intred, i=0; t; t = NEXT(t), i++ ) { |
|
printf("%d ",i); fflush(stdout); |
|
ti = BDY((LIST)BDY(t)); |
|
p[j=QTOS((Q)ARG0(ti))] = recompute_trace(BDY((LIST)ARG1(ti)),p,nb,mod); |
|
if ( j == 441 ) |
|
printf("afo"); |
|
} |
|
m = length(ind); |
|
MKMAT(mat,nb,m); |
|
for ( j = 0, t = ind; j < m; j++, t = NEXT(t) ) |
|
for ( i = 0, c = p[QTOS((Q)BDY(t))]; i < nb; i++ ) |
|
BDY(mat)[i][j] = ndtodp(mod,c[i]); |
|
return mat; |
|
} |
|
|
|
VECT nd_btog_one(LIST f,LIST v,int mod,struct order_spec *ord, |
|
LIST tlist,int pos,MAT *rp) |
|
{ |
|
int i,j,n,m,nb,pi0,pi1,nvar; |
|
VL fv,tv,vv; |
|
NODE permtrace,perm,trace,intred,ind,t,pi,ti; |
|
ND *p; |
|
ND *c; |
|
ND u; |
|
P inv; |
|
VECT vect; |
|
|
|
parse_nd_option(current_option); |
|
get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc); |
|
for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ ); |
|
switch ( ord->id ) { |
|
case 1: |
|
if ( ord->nv != nvar ) |
|
error("nd_check : invalid order specification"); |
|
break; |
|
default: |
|
break; |
|
} |
|
nd_init_ord(ord); |
|
#if 0 |
|
nd_bpe = QTOS((Q)ARG7(BDY(tlist))); |
|
#else |
|
nd_bpe = 32; |
|
#endif |
|
nd_setup_parameters(nvar,0); |
|
permtrace = BDY((LIST)ARG2(BDY(tlist))); |
|
intred = BDY((LIST)ARG3(BDY(tlist))); |
|
ind = BDY((LIST)ARG4(BDY(tlist))); |
|
perm = BDY((LIST)BDY(permtrace)); trace =NEXT(permtrace); |
|
for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) { |
|
j = QTOS((Q)BDY(BDY((LIST)BDY(t)))); |
|
if ( j > i ) i = j; |
|
} |
|
n = i+1; |
|
nb = length(BDY(f)); |
|
p = (ND *)MALLOC(n*sizeof(ND *)); |
|
for ( t = perm, i = 0; t; t = NEXT(t), i++ ) { |
|
pi = BDY((LIST)BDY(t)); |
|
pi0 = QTOS((Q)ARG0(pi)); pi1 = QTOS((Q)ARG1(pi)); |
|
if ( pi1 == pos ) { |
|
ptomp(mod,(P)ARG2(pi),&inv); |
|
u = ptond(CO,vv,(P)ONE); |
|
HCM(u) = ((MQ)inv)->cont; |
|
p[pi0] = u; |
|
} |
|
} |
|
for ( t = trace,i=0; t; t = NEXT(t), i++ ) { |
|
printf("%d ",i); fflush(stdout); |
|
ti = BDY((LIST)BDY(t)); |
|
p[j=QTOS((Q)ARG0(ti))] = recompute_trace_one(BDY((LIST)ARG1(ti)),p,nb,mod); |
|
} |
|
for ( t = intred, i=0; t; t = NEXT(t), i++ ) { |
|
printf("%d ",i); fflush(stdout); |
|
ti = BDY((LIST)BDY(t)); |
|
p[j=QTOS((Q)ARG0(ti))] = recompute_trace_one(BDY((LIST)ARG1(ti)),p,nb,mod); |
|
} |
|
m = length(ind); |
|
MKVECT(vect,m); |
|
for ( j = 0, t = ind; j < m; j++, t = NEXT(t) ) |
|
BDY(vect)[j] = ndtodp(mod,p[QTOS((Q)BDY(t))]); |
|
return vect; |
} |
} |