Annotation of OpenXM_contrib2/asir2018/engine/nd.c, Revision 1.20
1.20 ! noro 1: /* $OpenXM: OpenXM_contrib2/asir2018/engine/nd.c,v 1.19 2019/09/04 05:32:10 noro Exp $ */
1.1 noro 2:
3: #include "nd.h"
4:
1.11 noro 5: int Nnd_add,Nf4_red;
1.12 noro 6: struct oEGT eg_search,f4_symb,f4_conv,f4_elim1,f4_elim2;
1.1 noro 7:
8: int diag_period = 6;
9: int weight_check = 1;
10: int (*ndl_compare_function)(UINT *a1,UINT *a2);
1.19 noro 11: /* for schreyer order */
12: int (*ndl_base_compare_function)(UINT *a1,UINT *a2);
1.1 noro 13: int nd_dcomp;
14: int nd_rref2;
15: NM _nm_free_list;
16: ND _nd_free_list;
17: ND_pairs _ndp_free_list;
18: NODE nd_hcf;
19:
20: Obj nd_top_weight;
21:
22: static NODE nd_subst;
23: static VL nd_vc;
24: static int nd_ntrans;
25: static int nd_nalg;
26: #if 0
27: static int ndv_alloc;
28: #endif
29: #if 1
30: static int nd_f4_nsp=0x7fffffff;
31: #else
32: static int nd_f4_nsp=50;
33: #endif
34: static double nd_scale=2;
35: static UINT **nd_bound;
36: static struct order_spec *nd_ord;
37: static EPOS nd_epos;
38: static BlockMask nd_blockmask;
39: static int nd_nvar;
40: static int nd_isrlex;
41: static int nd_epw,nd_bpe,nd_wpd,nd_exporigin;
42: static UINT nd_mask[32];
43: static UINT nd_mask0,nd_mask1;
44:
45: static NDV *nd_ps;
46: static NDV *nd_ps_trace;
47: static NDV *nd_ps_sym;
48: static NDV *nd_ps_trace_sym;
49: static RHist *nd_psh;
50: static int nd_psn,nd_pslen;
51: static RHist *nd_red;
52: static int *nd_work_vector;
53: static int **nd_matrix;
54: static int nd_matrix_len;
55: static struct weight_or_block *nd_worb;
56: static int nd_worb_len;
57: static int nd_found,nd_create,nd_notfirst;
58: static int nmv_adv;
59: static int nd_demand;
60: static int nd_module,nd_ispot,nd_mpos,nd_pot_nelim;
61: static int nd_module_rank,nd_poly_weight_len;
62: static int *nd_poly_weight,*nd_module_weight;
63: static NODE nd_tracelist;
64: static NODE nd_alltracelist;
65: static int nd_gentrace,nd_gensyz,nd_nora,nd_newelim,nd_intersect,nd_lf;
66: static int *nd_gbblock;
67: static NODE nd_nzlist,nd_check_splist;
68: static int nd_splist;
69: static int *nd_sugarweight;
70: static int nd_f4red,nd_rank0,nd_last_nonzero;
71:
72: NumberField get_numberfield();
73: UINT *nd_det_compute_bound(NDV **dm,int n,int j);
74: void nd_det_reconstruct(NDV **dm,int n,int j,NDV d);
75: void nd_heu_nezgcdnpz(VL vl,P *pl,int m,int full,P *pr);
76: int nd_monic(int m,ND *p);
77: NDV plain_vect_to_ndv_q(Z *mat,int col,UINT *s0vect);
78: LIST ndvtopl(int mod,VL vl,VL dvl,NDV p,int rank);
79: NDV pltondv(VL vl,VL dvl,LIST p);
80: void pltozpl(LIST l,Q *cont,LIST *pp);
81: void ndl_max(UINT *d1,unsigned *d2,UINT *d);
82: void nmtodp(int mod,NM m,DP *r);
1.15 noro 83: void ndltodp(UINT *d,DP *r);
1.1 noro 84: NODE reverse_node(NODE n);
85: P ndc_div(int mod,union oNDC a,union oNDC b);
86: P ndctop(int mod,union oNDC c);
87: void finalize_tracelist(int i,P cont);
88: void conv_ilist(int demand,int trace,NODE g,int **indp);
89: void parse_nd_option(NODE opt);
90: void dltondl(int n,DL dl,UINT *r);
91: DP ndvtodp(int mod,NDV p);
92: DP ndtodp(int mod,ND p);
1.16 noro 93: DPM ndvtodpm(int mod,NDV p);
94: NDV dpmtondv(int mod,DPM p);
95: int dpm_getdeg(DPM p,int *rank);
96: void dpm_ptozp(DPM p,Z *cont,DPM *r);
97: int compdmm(int nv,DMM a,DMM b);
1.1 noro 98:
99: void Pdp_set_weight(NODE,VECT *);
100: void Pox_cmo_rpc(NODE,Obj *);
101:
102: ND nd_add_lf(ND p1,ND p2);
103: void nd_mul_c_lf(ND p,Z mul);
104: void ndv_mul_c_lf(NDV p,Z mul);
105: NODE nd_f4_red_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
106: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz);
107: NODE nd_f4_red_mod64_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
108: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz);
109: NODE nd_f4_red_lf_main(int m,ND_pairs sp0,int nsp,int trace,UINT *s0vect,int col,
110: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred);
111: int nd_gauss_elim_lf(mpz_t **mat0,int *sugar,int row,int col,int *colstat);
112: NODE nd_f4_lf_trace_main(int m,int **indp);
113: void nd_f4_lf_trace(LIST f,LIST v,int trace,int homo,struct order_spec *ord,LIST *rp);
114:
115: extern int lf_lazy;
116: extern Z current_mod_lf;
117:
118: extern int Denominator,DP_Multiple,MaxDeg;
119:
120: #define BLEN (8*sizeof(unsigned long))
121:
122: typedef struct matrix {
123: int row,col;
124: unsigned long **a;
125: } *matrix;
126:
127:
128: void nd_free_private_storage()
129: {
130: _nm_free_list = 0;
131: _ndp_free_list = 0;
132: #if 0
133: GC_gcollect();
134: #endif
135: }
136:
137: void _NM_alloc()
138: {
139: NM p;
140: int i;
141:
142: for ( i = 0; i < 1024; i++ ) {
143: p = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
144: p->next = _nm_free_list; _nm_free_list = p;
145: }
146: }
147:
148: matrix alloc_matrix(int row,int col)
149: {
150: unsigned long **a;
151: int i,len,blen;
152: matrix mat;
153:
154: mat = (matrix)MALLOC(sizeof(struct matrix));
155: mat->row = row;
156: mat->col = col;
157: mat->a = a = (unsigned long **)MALLOC(row*sizeof(unsigned long *));
158: return mat;
159: }
160:
161:
162: void _ND_alloc()
163: {
164: ND p;
165: int i;
166:
167: for ( i = 0; i < 1024; i++ ) {
168: p = (ND)MALLOC(sizeof(struct oND));
169: p->body = (NM)_nd_free_list; _nd_free_list = p;
170: }
171: }
172:
173: void _NDP_alloc()
174: {
175: ND_pairs p;
176: int i;
177:
178: for ( i = 0; i < 1024; i++ ) {
179: p = (ND_pairs)MALLOC(sizeof(struct oND_pairs)
180: +(nd_wpd-1)*sizeof(UINT));
181: p->next = _ndp_free_list; _ndp_free_list = p;
182: }
183: }
184:
185: INLINE int nd_length(ND p)
186: {
187: NM m;
188: int i;
189:
190: if ( !p )
191: return 0;
192: else {
193: for ( i = 0, m = BDY(p); m; m = NEXT(m), i++ );
194: return i;
195: }
196: }
197:
198: extern int dp_negative_weight;
199:
200: INLINE int ndl_reducible(UINT *d1,UINT *d2)
201: {
202: UINT u1,u2;
203: int i,j;
204:
205: if ( nd_module && (MPOS(d1) != MPOS(d2)) ) return 0;
206:
207: if ( !dp_negative_weight && TD(d1) < TD(d2) ) return 0;
208: #if USE_UNROLL
209: switch ( nd_bpe ) {
210: case 3:
211: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
212: u1 = d1[i]; u2 = d2[i];
213: if ( (u1&0x38000000) < (u2&0x38000000) ) return 0;
214: if ( (u1& 0x7000000) < (u2& 0x7000000) ) return 0;
215: if ( (u1& 0xe00000) < (u2& 0xe00000) ) return 0;
216: if ( (u1& 0x1c0000) < (u2& 0x1c0000) ) return 0;
217: if ( (u1& 0x38000) < (u2& 0x38000) ) return 0;
218: if ( (u1& 0x7000) < (u2& 0x7000) ) return 0;
219: if ( (u1& 0xe00) < (u2& 0xe00) ) return 0;
220: if ( (u1& 0x1c0) < (u2& 0x1c0) ) return 0;
221: if ( (u1& 0x38) < (u2& 0x38) ) return 0;
222: if ( (u1& 0x7) < (u2& 0x7) ) return 0;
223: }
224: return 1;
225: break;
226: case 4:
227: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
228: u1 = d1[i]; u2 = d2[i];
229: if ( (u1&0xf0000000) < (u2&0xf0000000) ) return 0;
230: if ( (u1& 0xf000000) < (u2& 0xf000000) ) return 0;
231: if ( (u1& 0xf00000) < (u2& 0xf00000) ) return 0;
232: if ( (u1& 0xf0000) < (u2& 0xf0000) ) return 0;
233: if ( (u1& 0xf000) < (u2& 0xf000) ) return 0;
234: if ( (u1& 0xf00) < (u2& 0xf00) ) return 0;
235: if ( (u1& 0xf0) < (u2& 0xf0) ) return 0;
236: if ( (u1& 0xf) < (u2& 0xf) ) return 0;
237: }
238: return 1;
239: break;
240: case 6:
241: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
242: u1 = d1[i]; u2 = d2[i];
243: if ( (u1&0x3f000000) < (u2&0x3f000000) ) return 0;
244: if ( (u1& 0xfc0000) < (u2& 0xfc0000) ) return 0;
245: if ( (u1& 0x3f000) < (u2& 0x3f000) ) return 0;
246: if ( (u1& 0xfc0) < (u2& 0xfc0) ) return 0;
247: if ( (u1& 0x3f) < (u2& 0x3f) ) return 0;
248: }
249: return 1;
250: break;
251: case 8:
252: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
253: u1 = d1[i]; u2 = d2[i];
254: if ( (u1&0xff000000) < (u2&0xff000000) ) return 0;
255: if ( (u1& 0xff0000) < (u2& 0xff0000) ) return 0;
256: if ( (u1& 0xff00) < (u2& 0xff00) ) return 0;
257: if ( (u1& 0xff) < (u2& 0xff) ) return 0;
258: }
259: return 1;
260: break;
261: case 16:
262: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
263: u1 = d1[i]; u2 = d2[i];
264: if ( (u1&0xffff0000) < (u2&0xffff0000) ) return 0;
265: if ( (u1& 0xffff) < (u2& 0xffff) ) return 0;
266: }
267: return 1;
268: break;
269: case 32:
270: for ( i = nd_exporigin; i < nd_wpd; i++ )
271: if ( d1[i] < d2[i] ) return 0;
272: return 1;
273: break;
274: default:
275: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
276: u1 = d1[i]; u2 = d2[i];
277: for ( j = 0; j < nd_epw; j++ )
278: if ( (u1&nd_mask[j]) < (u2&nd_mask[j]) ) return 0;
279: }
280: return 1;
281: }
282: #else
283: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
284: u1 = d1[i]; u2 = d2[i];
285: for ( j = 0; j < nd_epw; j++ )
286: if ( (u1&nd_mask[j]) < (u2&nd_mask[j]) ) return 0;
287: }
288: return 1;
289: #endif
290: }
291:
292: /*
293: * If the current order is a block order,
294: * then the last block is length 1 and contains
295: * the homo variable. Otherwise, the original
296: * order is either 0 or 2.
297: */
298:
299: void ndl_homogenize(UINT *d,UINT *r,int obpe,EPOS oepos,int ompos,int weight)
300: {
301: int w,i,e,n,omask0;
302:
303: omask0 = obpe==32?0xffffffff:((1<<obpe)-1);
304: n = nd_nvar-1;
305: ndl_zero(r);
306: for ( i = 0; i < n; i++ ) {
307: e = GET_EXP_OLD(d,i);
308: PUT_EXP(r,i,e);
309: }
310: w = TD(d);
311: PUT_EXP(r,nd_nvar-1,weight-w);
312: if ( nd_module ) MPOS(r) = d[ompos];
313: TD(r) = weight;
314: if ( nd_blockmask ) ndl_weight_mask(r);
315: }
316:
317: void ndl_dehomogenize(UINT *d)
318: {
319: UINT mask;
320: UINT h;
321: int i,bits;
322:
323: if ( nd_blockmask ) {
324: h = GET_EXP(d,nd_nvar-1);
325: XOR_EXP(d,nd_nvar-1,h);
326: TD(d) -= h;
327: ndl_weight_mask(d);
328: } else {
329: if ( nd_isrlex ) {
330: if ( nd_bpe == 32 ) {
331: h = d[nd_exporigin];
332: for ( i = nd_exporigin+1; i < nd_wpd; i++ )
333: d[i-1] = d[i];
334: d[i-1] = 0;
335: TD(d) -= h;
336: } else {
337: bits = nd_epw*nd_bpe;
338: mask = bits==32?0xffffffff:((1<<(nd_epw*nd_bpe))-1);
339: h = (d[nd_exporigin]>>((nd_epw-1)*nd_bpe))&nd_mask0;
340: for ( i = nd_exporigin; i < nd_wpd; i++ )
341: d[i] = ((d[i]<<nd_bpe)&mask)
342: |(i+1<nd_wpd?((d[i+1]>>((nd_epw-1)*nd_bpe))&nd_mask0):0);
343: TD(d) -= h;
344: }
345: } else {
346: h = GET_EXP(d,nd_nvar-1);
347: XOR_EXP(d,nd_nvar-1,h);
348: TD(d) -= h;
349: }
350: }
351: }
352:
353: void ndl_lcm(UINT *d1,unsigned *d2,UINT *d)
354: {
355: UINT t1,t2,u,u1,u2;
356: int i,j,l;
357:
358: if ( nd_module && (MPOS(d1) != MPOS(d2)) )
359: error("ndl_lcm : inconsistent monomials");
360: #if USE_UNROLL
361: switch ( nd_bpe ) {
362: case 3:
363: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
364: u1 = d1[i]; u2 = d2[i];
365: t1 = (u1&0x38000000); t2 = (u2&0x38000000); u = t1>t2?t1:t2;
366: t1 = (u1& 0x7000000); t2 = (u2& 0x7000000); u |= t1>t2?t1:t2;
367: t1 = (u1& 0xe00000); t2 = (u2& 0xe00000); u |= t1>t2?t1:t2;
368: t1 = (u1& 0x1c0000); t2 = (u2& 0x1c0000); u |= t1>t2?t1:t2;
369: t1 = (u1& 0x38000); t2 = (u2& 0x38000); u |= t1>t2?t1:t2;
370: t1 = (u1& 0x7000); t2 = (u2& 0x7000); u |= t1>t2?t1:t2;
371: t1 = (u1& 0xe00); t2 = (u2& 0xe00); u |= t1>t2?t1:t2;
372: t1 = (u1& 0x1c0); t2 = (u2& 0x1c0); u |= t1>t2?t1:t2;
373: t1 = (u1& 0x38); t2 = (u2& 0x38); u |= t1>t2?t1:t2;
374: t1 = (u1& 0x7); t2 = (u2& 0x7); u |= t1>t2?t1:t2;
375: d[i] = u;
376: }
377: break;
378: case 4:
379: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
380: u1 = d1[i]; u2 = d2[i];
381: t1 = (u1&0xf0000000); t2 = (u2&0xf0000000); u = t1>t2?t1:t2;
382: t1 = (u1& 0xf000000); t2 = (u2& 0xf000000); u |= t1>t2?t1:t2;
383: t1 = (u1& 0xf00000); t2 = (u2& 0xf00000); u |= t1>t2?t1:t2;
384: t1 = (u1& 0xf0000); t2 = (u2& 0xf0000); u |= t1>t2?t1:t2;
385: t1 = (u1& 0xf000); t2 = (u2& 0xf000); u |= t1>t2?t1:t2;
386: t1 = (u1& 0xf00); t2 = (u2& 0xf00); u |= t1>t2?t1:t2;
387: t1 = (u1& 0xf0); t2 = (u2& 0xf0); u |= t1>t2?t1:t2;
388: t1 = (u1& 0xf); t2 = (u2& 0xf); u |= t1>t2?t1:t2;
389: d[i] = u;
390: }
391: break;
392: case 6:
393: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
394: u1 = d1[i]; u2 = d2[i];
395: t1 = (u1&0x3f000000); t2 = (u2&0x3f000000); u = t1>t2?t1:t2;
396: t1 = (u1& 0xfc0000); t2 = (u2& 0xfc0000); u |= t1>t2?t1:t2;
397: t1 = (u1& 0x3f000); t2 = (u2& 0x3f000); u |= t1>t2?t1:t2;
398: t1 = (u1& 0xfc0); t2 = (u2& 0xfc0); u |= t1>t2?t1:t2;
399: t1 = (u1& 0x3f); t2 = (u2& 0x3f); u |= t1>t2?t1:t2;
400: d[i] = u;
401: }
402: break;
403: case 8:
404: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
405: u1 = d1[i]; u2 = d2[i];
406: t1 = (u1&0xff000000); t2 = (u2&0xff000000); u = t1>t2?t1:t2;
407: t1 = (u1& 0xff0000); t2 = (u2& 0xff0000); u |= t1>t2?t1:t2;
408: t1 = (u1& 0xff00); t2 = (u2& 0xff00); u |= t1>t2?t1:t2;
409: t1 = (u1& 0xff); t2 = (u2& 0xff); u |= t1>t2?t1:t2;
410: d[i] = u;
411: }
412: break;
413: case 16:
414: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
415: u1 = d1[i]; u2 = d2[i];
416: t1 = (u1&0xffff0000); t2 = (u2&0xffff0000); u = t1>t2?t1:t2;
417: t1 = (u1& 0xffff); t2 = (u2& 0xffff); u |= t1>t2?t1:t2;
418: d[i] = u;
419: }
420: break;
421: case 32:
422: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
423: u1 = d1[i]; u2 = d2[i];
424: d[i] = u1>u2?u1:u2;
425: }
426: break;
427: default:
428: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
429: u1 = d1[i]; u2 = d2[i];
430: for ( j = 0, u = 0; j < nd_epw; j++ ) {
431: t1 = (u1&nd_mask[j]); t2 = (u2&nd_mask[j]); u |= t1>t2?t1:t2;
432: }
433: d[i] = u;
434: }
435: break;
436: }
437: #else
438: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
439: u1 = d1[i]; u2 = d2[i];
440: for ( j = 0, u = 0; j < nd_epw; j++ ) {
441: t1 = (u1&nd_mask[j]); t2 = (u2&nd_mask[j]); u |= t1>t2?t1:t2;
442: }
443: d[i] = u;
444: }
445: #endif
446: if ( nd_module ) MPOS(d) = MPOS(d1);
447: TD(d) = ndl_weight(d);
448: if ( nd_blockmask ) ndl_weight_mask(d);
449: }
450:
451: void ndl_max(UINT *d1,unsigned *d2,UINT *d)
452: {
453: UINT t1,t2,u,u1,u2;
454: int i,j,l;
455:
456: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
457: u1 = d1[i]; u2 = d2[i];
458: for ( j = 0, u = 0; j < nd_epw; j++ ) {
459: t1 = (u1&nd_mask[j]); t2 = (u2&nd_mask[j]); u |= t1>t2?t1:t2;
460: }
461: d[i] = u;
462: }
463: }
464:
465: int ndl_weight(UINT *d)
466: {
467: UINT t,u;
468: int i,j;
469:
470: if ( current_dl_weight_vector )
471: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
472: u = GET_EXP(d,i);
473: t += MUL_WEIGHT(u,i);
474: }
475: else
476: for ( t = 0, i = nd_exporigin; i < nd_wpd; i++ ) {
477: u = d[i];
478: for ( j = 0; j < nd_epw; j++, u>>=nd_bpe )
479: t += (u&nd_mask0);
480: }
1.20 ! noro 481: if ( nd_module && nd_module_rank && MPOS(d) )
! 482: t += nd_module_weight[MPOS(d)-1];
! 483: for ( i = nd_exporigin; i < nd_wpd; i++ )
! 484: if ( d[i] && !t )
! 485: printf("afo\n");
1.1 noro 486: return t;
487: }
488:
489: /* for sugarweight */
490:
491: int ndl_weight2(UINT *d)
492: {
493: int t,u;
494: int i,j;
495:
496: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
497: u = GET_EXP(d,i);
498: t += nd_sugarweight[i]*u;
499: }
1.20 ! noro 500: if ( nd_module && nd_module_rank && MPOS(d) )
! 501: t += nd_module_weight[MPOS(d)-1];
1.1 noro 502: return t;
503: }
504:
505: void ndl_weight_mask(UINT *d)
506: {
507: UINT t,u;
508: UINT *mask;
509: int i,j,k,l;
510:
511: l = nd_blockmask->n;
512: for ( k = 0; k < l; k++ ) {
513: mask = nd_blockmask->mask[k];
514: if ( current_dl_weight_vector )
515: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
516: u = GET_EXP_MASK(d,i,mask);
517: t += MUL_WEIGHT(u,i);
518: }
519: else
520: for ( t = 0, i = nd_exporigin; i < nd_wpd; i++ ) {
521: u = d[i]&mask[i];
522: for ( j = 0; j < nd_epw; j++, u>>=nd_bpe )
523: t += (u&nd_mask0);
524: }
525: d[k+1] = t;
526: }
527: }
528:
529: int ndl_lex_compare(UINT *d1,UINT *d2)
530: {
531: int i;
532:
533: d1 += nd_exporigin;
534: d2 += nd_exporigin;
535: for ( i = nd_exporigin; i < nd_wpd; i++, d1++, d2++ )
536: if ( *d1 > *d2 )
537: return nd_isrlex ? -1 : 1;
538: else if ( *d1 < *d2 )
539: return nd_isrlex ? 1 : -1;
540: return 0;
541: }
542:
543: int ndl_block_compare(UINT *d1,UINT *d2)
544: {
545: int i,l,j,ord_o,ord_l;
546: struct order_pair *op;
547: UINT t1,t2,m;
548: UINT *mask;
549:
550: l = nd_blockmask->n;
551: op = nd_blockmask->order_pair;
552: for ( j = 0; j < l; j++ ) {
553: mask = nd_blockmask->mask[j];
554: ord_o = op[j].order;
555: if ( ord_o < 2 ) {
556: if ( (t1=d1[j+1]) > (t2=d2[j+1]) ) return 1;
557: else if ( t1 < t2 ) return -1;
558: }
559: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
560: m = mask[i];
561: t1 = d1[i]&m;
562: t2 = d2[i]&m;
563: if ( t1 > t2 )
564: return !ord_o ? -1 : 1;
565: else if ( t1 < t2 )
566: return !ord_o ? 1 : -1;
567: }
568: }
569: return 0;
570: }
571:
572: int ndl_matrix_compare(UINT *d1,UINT *d2)
573: {
574: int i,j,s,row;
575: int *v;
576: Z **mat;
577: Z *w;
578: Z t1;
579: Z t,t2;
580:
1.6 noro 581: for ( j = 0; j < nd_nvar; j++ )
582: nd_work_vector[j] = GET_EXP(d1,j)-GET_EXP(d2,j);
1.1 noro 583: if ( nd_top_weight ) {
584: if ( OID(nd_top_weight) == O_VECT ) {
1.6 noro 585: mat = (Z **)&BDY((VECT)nd_top_weight);
586: row = 1;
1.1 noro 587: } else {
588: mat = (Z **)BDY((MAT)nd_top_weight);
1.6 noro 589: row = ((MAT)nd_top_weight)->row;
1.1 noro 590: }
591: for ( i = 0; i < row; i++ ) {
1.6 noro 592: w = mat[i];
1.1 noro 593: for ( j = 0, t = 0; j < nd_nvar; j++ ) {
1.6 noro 594: STOZ(nd_work_vector[j],t1);
1.1 noro 595: mulz(w[j],t1,&t2);
596: addz(t,t2,&t1);
597: t = t1;
598: }
1.6 noro 599: if ( t ) {
600: s = sgnz(t);
1.1 noro 601: if ( s > 0 ) return 1;
602: else if ( s < 0 ) return -1;
1.6 noro 603: }
1.1 noro 604: }
1.6 noro 605: }
606: for ( i = 0; i < nd_matrix_len; i++ ) {
607: v = nd_matrix[i];
608: for ( j = 0, s = 0; j < nd_nvar; j++ )
609: s += v[j]*nd_work_vector[j];
610: if ( s > 0 ) return 1;
611: else if ( s < 0 ) return -1;
612: }
1.1 noro 613: if ( !ndl_equal(d1,d2) )
1.6 noro 614: error("ndl_matrix_compare : invalid matrix");
615: return 0;
1.1 noro 616: }
617:
618: int ndl_composite_compare(UINT *d1,UINT *d2)
619: {
620: int i,j,s,start,end,len,o;
621: int *v;
622: struct sparse_weight *sw;
623:
624: for ( j = 0; j < nd_nvar; j++ )
625: nd_work_vector[j] = GET_EXP(d1,j)-GET_EXP(d2,j);
626: for ( i = 0; i < nd_worb_len; i++ ) {
627: len = nd_worb[i].length;
628: switch ( nd_worb[i].type ) {
629: case IS_DENSE_WEIGHT:
630: v = nd_worb[i].body.dense_weight;
631: for ( j = 0, s = 0; j < len; j++ )
632: s += v[j]*nd_work_vector[j];
633: if ( s > 0 ) return 1;
634: else if ( s < 0 ) return -1;
635: break;
636: case IS_SPARSE_WEIGHT:
637: sw = nd_worb[i].body.sparse_weight;
638: for ( j = 0, s = 0; j < len; j++ )
639: s += sw[j].value*nd_work_vector[sw[j].pos];
640: if ( s > 0 ) return 1;
641: else if ( s < 0 ) return -1;
642: break;
643: case IS_BLOCK:
644: o = nd_worb[i].body.block.order;
645: start = nd_worb[i].body.block.start;
646: switch ( o ) {
647: case 0:
648: end = start+len;
649: for ( j = start, s = 0; j < end; j++ )
650: s += MUL_WEIGHT(nd_work_vector[j],j);
651: if ( s > 0 ) return 1;
652: else if ( s < 0 ) return -1;
653: for ( j = end-1; j >= start; j-- )
654: if ( nd_work_vector[j] < 0 ) return 1;
655: else if ( nd_work_vector[j] > 0 ) return -1;
656: break;
657: case 1:
658: end = start+len;
659: for ( j = start, s = 0; j < end; j++ )
660: s += MUL_WEIGHT(nd_work_vector[j],j);
661: if ( s > 0 ) return 1;
662: else if ( s < 0 ) return -1;
663: for ( j = start; j < end; j++ )
664: if ( nd_work_vector[j] > 0 ) return 1;
665: else if ( nd_work_vector[j] < 0 ) return -1;
666: break;
667: case 2:
668: end = start+len;
669: for ( j = start; j < end; j++ )
670: if ( nd_work_vector[j] > 0 ) return 1;
671: else if ( nd_work_vector[j] < 0 ) return -1;
672: break;
673: }
674: break;
675: }
676: }
677: return 0;
678: }
679:
680: /* TDH -> WW -> TD-> RL */
681:
682: int ndl_ww_lex_compare(UINT *d1,UINT *d2)
683: {
684: int i,m,e1,e2;
685:
686: if ( TD(d1) > TD(d2) ) return 1;
687: else if ( TD(d1) < TD(d2) ) return -1;
688: m = nd_nvar>>1;
689: for ( i = 0, e1 = e2 = 0; i < m; i++ ) {
690: e1 += current_weyl_weight_vector[i]*(GET_EXP(d1,m+i)-GET_EXP(d1,i));
691: e2 += current_weyl_weight_vector[i]*(GET_EXP(d2,m+i)-GET_EXP(d2,i));
692: }
693: if ( e1 > e2 ) return 1;
694: else if ( e1 < e2 ) return -1;
695: return ndl_lex_compare(d1,d2);
696: }
697:
698: int ndl_module_weight_compare(UINT *d1,UINT *d2)
699: {
700: int s,j;
701:
702: if ( nd_nvar != nd_poly_weight_len )
703: error("invalid module weight : the length of polynomial weight != the number of variables");
704: s = 0;
705: for ( j = 0; j < nd_nvar; j++ )
706: s += (GET_EXP(d1,j)-GET_EXP(d2,j))*nd_poly_weight[j];
707: if ( MPOS(d1) >= 1 && MPOS(d2) >= 1 ) {
708: s += nd_module_weight[MPOS(d1)-1]-nd_module_weight[MPOS(d2)-1];
709: }
710: if ( s > 0 ) return 1;
711: else if ( s < 0 ) return -1;
712: else return 0;
713: }
714:
715: int ndl_module_grlex_compare(UINT *d1,UINT *d2)
716: {
717: int i,c;
718:
1.20 ! noro 719: // if ( nd_module_rank && (c = ndl_module_weight_compare(d1,d2)) ) return c;
1.1 noro 720: if ( nd_ispot ) {
1.19 noro 721: if ( nd_pot_nelim && MPOS(d1)>=nd_pot_nelim+1 && MPOS(d2) >= nd_pot_nelim+1 ) {
722: if ( TD(d1) > TD(d2) ) return 1;
723: else if ( TD(d1) < TD(d2) ) return -1;
724: if ( (c = ndl_lex_compare(d1,d2)) != 0 ) return c;
725: if ( MPOS(d1) < MPOS(d2) ) return 1;
726: else if ( MPOS(d1) > MPOS(d2) ) return -1;
727: return 0;
728: }
729: if ( MPOS(d1) < MPOS(d2) ) return 1;
730: else if ( MPOS(d1) > MPOS(d2) ) return -1;
1.1 noro 731: }
732: if ( TD(d1) > TD(d2) ) return 1;
733: else if ( TD(d1) < TD(d2) ) return -1;
734: if ( (c = ndl_lex_compare(d1,d2)) != 0 ) return c;
735: if ( !nd_ispot ) {
736: if ( MPOS(d1) < MPOS(d2) ) return 1;
737: else if ( MPOS(d1) > MPOS(d2) ) return -1;
738: }
739: return 0;
740: }
741:
742: int ndl_module_glex_compare(UINT *d1,UINT *d2)
743: {
744: int i,c;
745:
1.20 ! noro 746: // if ( nd_module_rank && (c = ndl_module_weight_compare(d1,d2)) ) return c;
1.1 noro 747: if ( nd_ispot ) {
748: if ( MPOS(d1) < MPOS(d2) ) return 1;
749: else if ( MPOS(d1) > MPOS(d2) ) return -1;
750: }
751: if ( TD(d1) > TD(d2) ) return 1;
752: else if ( TD(d1) < TD(d2) ) return -1;
753: if ( (c = ndl_lex_compare(d1,d2)) != 0 ) return c;
754: if ( !nd_ispot ) {
755: if ( MPOS(d1) < MPOS(d2) ) return 1;
756: else if ( MPOS(d1) > MPOS(d2) ) return -1;
757: }
758: return 0;
759: }
760:
761: int ndl_module_lex_compare(UINT *d1,UINT *d2)
762: {
763: int i,c;
764:
1.20 ! noro 765: // if ( nd_module_rank && (c = ndl_module_weight_compare(d1,d2)) ) return c;
1.1 noro 766: if ( nd_ispot ) {
767: if ( MPOS(d1) < MPOS(d2) ) return 1;
768: else if ( MPOS(d1) > MPOS(d2) ) return -1;
769: }
770: if ( (c = ndl_lex_compare(d1,d2)) != 0 ) return c;
771: if ( !nd_ispot ) {
772: if ( MPOS(d1) < MPOS(d2) ) return 1;
773: else if ( MPOS(d1) > MPOS(d2) ) return -1;
774: }
775: return 0;
776: }
777:
778: int ndl_module_block_compare(UINT *d1,UINT *d2)
779: {
780: int i,c;
781:
1.20 ! noro 782: // if ( nd_module_rank && (c = ndl_module_weight_compare(d1,d2)) ) return c;
1.1 noro 783: if ( nd_ispot ) {
784: if ( MPOS(d1) < MPOS(d2) ) return 1;
785: else if ( MPOS(d1) > MPOS(d2) ) return -1;
786: }
787: if ( (c = ndl_block_compare(d1,d2)) != 0 ) return c;
788: if ( !nd_ispot ) {
789: if ( MPOS(d1) < MPOS(d2) ) return 1;
790: else if ( MPOS(d1) > MPOS(d2) ) return -1;
791: }
792: return 0;
793: }
794:
795: int ndl_module_matrix_compare(UINT *d1,UINT *d2)
796: {
797: int i,c;
798:
1.20 ! noro 799: // if ( nd_module_rank && (c = ndl_module_weight_compare(d1,d2)) ) return c;
1.1 noro 800: if ( nd_ispot ) {
801: if ( MPOS(d1) < MPOS(d2) ) return 1;
802: else if ( MPOS(d1) > MPOS(d2) ) return -1;
803: }
804: if ( (c = ndl_matrix_compare(d1,d2)) != 0 ) return c;
805: if ( !nd_ispot ) {
806: if ( MPOS(d1) < MPOS(d2) ) return 1;
807: else if ( MPOS(d1) > MPOS(d2) ) return -1;
808: }
809: return 0;
810: }
811:
812: int ndl_module_composite_compare(UINT *d1,UINT *d2)
813: {
814: int i,c;
815:
1.20 ! noro 816: // if ( nd_module_rank && (c = ndl_module_weight_compare(d1,d2)) ) return c;
1.1 noro 817: if ( nd_ispot ) {
818: if ( MPOS(d1) > MPOS(d2) ) return 1;
819: else if ( MPOS(d1) < MPOS(d2) ) return -1;
820: }
821: if ( (c = ndl_composite_compare(d1,d2)) != 0 ) return c;
822: if ( !nd_ispot ) {
823: if ( MPOS(d1) > MPOS(d2) ) return 1;
824: else if ( MPOS(d1) < MPOS(d2) ) return -1;
825: }
826: return 0;
827: }
828:
829: INLINE int ndl_equal(UINT *d1,UINT *d2)
830: {
831: int i;
832:
833: switch ( nd_wpd ) {
834: case 2:
835: if ( TD(d2) != TD(d1) ) return 0;
836: if ( d2[1] != d1[1] ) return 0;
837: return 1;
838: break;
839: case 3:
840: if ( TD(d2) != TD(d1) ) return 0;
841: if ( d2[1] != d1[1] ) return 0;
842: if ( d2[2] != d1[2] ) return 0;
843: return 1;
844: break;
845: default:
846: for ( i = 0; i < nd_wpd; i++ )
847: if ( *d1++ != *d2++ ) return 0;
848: return 1;
849: break;
850: }
851: }
852:
853: INLINE void ndl_copy(UINT *d1,UINT *d2)
854: {
855: int i;
856:
857: switch ( nd_wpd ) {
858: case 2:
859: TD(d2) = TD(d1);
860: d2[1] = d1[1];
861: break;
862: case 3:
863: TD(d2) = TD(d1);
864: d2[1] = d1[1];
865: d2[2] = d1[2];
866: break;
867: default:
868: for ( i = 0; i < nd_wpd; i++ )
869: d2[i] = d1[i];
870: break;
871: }
872: }
873:
874: INLINE void ndl_zero(UINT *d)
875: {
876: int i;
877: for ( i = 0; i < nd_wpd; i++ ) d[i] = 0;
878: }
879:
880: INLINE void ndl_add(UINT *d1,UINT *d2,UINT *d)
881: {
882: int i;
883:
884: if ( nd_module ) {
885: if ( MPOS(d1) && MPOS(d2) && (MPOS(d1) != MPOS(d2)) )
886: error("ndl_add : invalid operation");
887: }
888: #if 1
889: switch ( nd_wpd ) {
890: case 2:
891: TD(d) = TD(d1)+TD(d2);
892: d[1] = d1[1]+d2[1];
893: break;
894: case 3:
895: TD(d) = TD(d1)+TD(d2);
896: d[1] = d1[1]+d2[1];
897: d[2] = d1[2]+d2[2];
898: break;
899: default:
900: for ( i = 0; i < nd_wpd; i++ ) d[i] = d1[i]+d2[i];
901: break;
902: }
903: #else
904: for ( i = 0; i < nd_wpd; i++ ) d[i] = d1[i]+d2[i];
905: #endif
906: }
907:
908: /* d1 += d2 */
909: INLINE void ndl_addto(UINT *d1,UINT *d2)
910: {
911: int i;
912:
913: if ( nd_module ) {
914: if ( MPOS(d1) && MPOS(d2) && (MPOS(d1) != MPOS(d2)) )
915: error("ndl_addto : invalid operation");
916: }
917: #if 1
918: switch ( nd_wpd ) {
919: case 2:
920: TD(d1) += TD(d2);
921: d1[1] += d2[1];
922: break;
923: case 3:
924: TD(d1) += TD(d2);
925: d1[1] += d2[1];
926: d1[2] += d2[2];
927: break;
928: default:
929: for ( i = 0; i < nd_wpd; i++ ) d1[i] += d2[i];
930: break;
931: }
932: #else
933: for ( i = 0; i < nd_wpd; i++ ) d1[i] += d2[i];
934: #endif
935: }
936:
937: INLINE void ndl_sub(UINT *d1,UINT *d2,UINT *d)
938: {
939: int i;
940:
941: for ( i = 0; i < nd_wpd; i++ ) d[i] = d1[i]-d2[i];
942: }
943:
944: int ndl_disjoint(UINT *d1,UINT *d2)
945: {
946: UINT t1,t2,u,u1,u2;
947: int i,j;
948:
949: if ( nd_module && (MPOS(d1) == MPOS(d2)) ) return 0;
950: #if USE_UNROLL
951: switch ( nd_bpe ) {
952: case 3:
953: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
954: u1 = d1[i]; u2 = d2[i];
955: t1 = u1&0x38000000; t2 = u2&0x38000000; if ( t1&&t2 ) return 0;
956: t1 = u1& 0x7000000; t2 = u2& 0x7000000; if ( t1&&t2 ) return 0;
957: t1 = u1& 0xe00000; t2 = u2& 0xe00000; if ( t1&&t2 ) return 0;
958: t1 = u1& 0x1c0000; t2 = u2& 0x1c0000; if ( t1&&t2 ) return 0;
959: t1 = u1& 0x38000; t2 = u2& 0x38000; if ( t1&&t2 ) return 0;
960: t1 = u1& 0x7000; t2 = u2& 0x7000; if ( t1&&t2 ) return 0;
961: t1 = u1& 0xe00; t2 = u2& 0xe00; if ( t1&&t2 ) return 0;
962: t1 = u1& 0x1c0; t2 = u2& 0x1c0; if ( t1&&t2 ) return 0;
963: t1 = u1& 0x38; t2 = u2& 0x38; if ( t1&&t2 ) return 0;
964: t1 = u1& 0x7; t2 = u2& 0x7; if ( t1&&t2 ) return 0;
965: }
966: return 1;
967: break;
968: case 4:
969: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
970: u1 = d1[i]; u2 = d2[i];
971: t1 = u1&0xf0000000; t2 = u2&0xf0000000; if ( t1&&t2 ) return 0;
972: t1 = u1& 0xf000000; t2 = u2& 0xf000000; if ( t1&&t2 ) return 0;
973: t1 = u1& 0xf00000; t2 = u2& 0xf00000; if ( t1&&t2 ) return 0;
974: t1 = u1& 0xf0000; t2 = u2& 0xf0000; if ( t1&&t2 ) return 0;
975: t1 = u1& 0xf000; t2 = u2& 0xf000; if ( t1&&t2 ) return 0;
976: t1 = u1& 0xf00; t2 = u2& 0xf00; if ( t1&&t2 ) return 0;
977: t1 = u1& 0xf0; t2 = u2& 0xf0; if ( t1&&t2 ) return 0;
978: t1 = u1& 0xf; t2 = u2& 0xf; if ( t1&&t2 ) return 0;
979: }
980: return 1;
981: break;
982: case 6:
983: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
984: u1 = d1[i]; u2 = d2[i];
985: t1 = u1&0x3f000000; t2 = u2&0x3f000000; if ( t1&&t2 ) return 0;
986: t1 = u1& 0xfc0000; t2 = u2& 0xfc0000; if ( t1&&t2 ) return 0;
987: t1 = u1& 0x3f000; t2 = u2& 0x3f000; if ( t1&&t2 ) return 0;
988: t1 = u1& 0xfc0; t2 = u2& 0xfc0; if ( t1&&t2 ) return 0;
989: t1 = u1& 0x3f; t2 = u2& 0x3f; if ( t1&&t2 ) return 0;
990: }
991: return 1;
992: break;
993: case 8:
994: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
995: u1 = d1[i]; u2 = d2[i];
996: t1 = u1&0xff000000; t2 = u2&0xff000000; if ( t1&&t2 ) return 0;
997: t1 = u1& 0xff0000; t2 = u2& 0xff0000; if ( t1&&t2 ) return 0;
998: t1 = u1& 0xff00; t2 = u2& 0xff00; if ( t1&&t2 ) return 0;
999: t1 = u1& 0xff; t2 = u2& 0xff; if ( t1&&t2 ) return 0;
1000: }
1001: return 1;
1002: break;
1003: case 16:
1004: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1005: u1 = d1[i]; u2 = d2[i];
1006: t1 = u1&0xffff0000; t2 = u2&0xffff0000; if ( t1&&t2 ) return 0;
1007: t1 = u1& 0xffff; t2 = u2& 0xffff; if ( t1&&t2 ) return 0;
1008: }
1009: return 1;
1010: break;
1011: case 32:
1012: for ( i = nd_exporigin; i < nd_wpd; i++ )
1013: if ( d1[i] && d2[i] ) return 0;
1014: return 1;
1015: break;
1016: default:
1017: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1018: u1 = d1[i]; u2 = d2[i];
1019: for ( j = 0; j < nd_epw; j++ ) {
1020: if ( (u1&nd_mask0) && (u2&nd_mask0) ) return 0;
1021: u1 >>= nd_bpe; u2 >>= nd_bpe;
1022: }
1023: }
1024: return 1;
1025: break;
1026: }
1027: #else
1028: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1029: u1 = d1[i]; u2 = d2[i];
1030: for ( j = 0; j < nd_epw; j++ ) {
1031: if ( (u1&nd_mask0) && (u2&nd_mask0) ) return 0;
1032: u1 >>= nd_bpe; u2 >>= nd_bpe;
1033: }
1034: }
1035: return 1;
1036: #endif
1037: }
1038:
1039: int ndl_check_bound(UINT *d1,UINT *d2)
1040: {
1041: UINT u2;
1042: int i,j,ind,k;
1043:
1044: ind = 0;
1045: #if USE_UNROLL
1046: switch ( nd_bpe ) {
1047: case 3:
1048: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1049: u2 = d2[i];
1050: if ( d1[ind++]+((u2>>27)&0x7) >= 0x8 ) return 1;
1051: if ( d1[ind++]+((u2>>24)&0x7) >= 0x8 ) return 1;
1052: if ( d1[ind++]+((u2>>21)&0x7) >= 0x8 ) return 1;
1053: if ( d1[ind++]+((u2>>18)&0x7) >= 0x8 ) return 1;
1054: if ( d1[ind++]+((u2>>15)&0x7) >= 0x8 ) return 1;
1055: if ( d1[ind++]+((u2>>12)&0x7) >= 0x8 ) return 1;
1056: if ( d1[ind++]+((u2>>9)&0x7) >= 0x8 ) return 1;
1057: if ( d1[ind++]+((u2>>6)&0x7) >= 0x8 ) return 1;
1058: if ( d1[ind++]+((u2>>3)&0x7) >= 0x8 ) return 1;
1059: if ( d1[ind++]+(u2&0x7) >= 0x8 ) return 1;
1060: }
1061: return 0;
1062: break;
1063: case 4:
1064: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1065: u2 = d2[i];
1066: if ( d1[ind++]+((u2>>28)&0xf) >= 0x10 ) return 1;
1067: if ( d1[ind++]+((u2>>24)&0xf) >= 0x10 ) return 1;
1068: if ( d1[ind++]+((u2>>20)&0xf) >= 0x10 ) return 1;
1069: if ( d1[ind++]+((u2>>16)&0xf) >= 0x10 ) return 1;
1070: if ( d1[ind++]+((u2>>12)&0xf) >= 0x10 ) return 1;
1071: if ( d1[ind++]+((u2>>8)&0xf) >= 0x10 ) return 1;
1072: if ( d1[ind++]+((u2>>4)&0xf) >= 0x10 ) return 1;
1073: if ( d1[ind++]+(u2&0xf) >= 0x10 ) return 1;
1074: }
1075: return 0;
1076: break;
1077: case 6:
1078: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1079: u2 = d2[i];
1080: if ( d1[ind++]+((u2>>24)&0x3f) >= 0x40 ) return 1;
1081: if ( d1[ind++]+((u2>>18)&0x3f) >= 0x40 ) return 1;
1082: if ( d1[ind++]+((u2>>12)&0x3f) >= 0x40 ) return 1;
1083: if ( d1[ind++]+((u2>>6)&0x3f) >= 0x40 ) return 1;
1084: if ( d1[ind++]+(u2&0x3f) >= 0x40 ) return 1;
1085: }
1086: return 0;
1087: break;
1088: case 8:
1089: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1090: u2 = d2[i];
1091: if ( d1[ind++]+((u2>>24)&0xff) >= 0x100 ) return 1;
1092: if ( d1[ind++]+((u2>>16)&0xff) >= 0x100 ) return 1;
1093: if ( d1[ind++]+((u2>>8)&0xff) >= 0x100 ) return 1;
1094: if ( d1[ind++]+(u2&0xff) >= 0x100 ) return 1;
1095: }
1096: return 0;
1097: break;
1098: case 16:
1099: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1100: u2 = d2[i];
1101: if ( d1[ind++]+((u2>>16)&0xffff) > 0x10000 ) return 1;
1102: if ( d1[ind++]+(u2&0xffff) > 0x10000 ) return 1;
1103: }
1104: return 0;
1105: break;
1106: case 32:
1107: for ( i = nd_exporigin; i < nd_wpd; i++ )
1108: if ( d1[i]+d2[i]<d1[i] ) return 1;
1109: return 0;
1110: break;
1111: default:
1112: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1113: u2 = d2[i];
1114: k = (nd_epw-1)*nd_bpe;
1115: for ( j = 0; j < nd_epw; j++, k -= nd_bpe )
1116: if ( d1[ind++]+((u2>>k)&nd_mask0) > nd_mask0 ) return 1;
1117: }
1118: return 0;
1119: break;
1120: }
1121: #else
1122: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1123: u2 = d2[i];
1124: k = (nd_epw-1)*nd_bpe;
1125: for ( j = 0; j < nd_epw; j++, k -= nd_bpe )
1126: if ( d1[ind++]+((u2>>k)&nd_mask0) > nd_mask0 ) return 1;
1127: }
1128: return 0;
1129: #endif
1130: }
1131:
1132: int ndl_check_bound2(int index,UINT *d2)
1133: {
1134: return ndl_check_bound(nd_bound[index],d2);
1135: }
1136:
1137: INLINE int ndl_hash_value(UINT *d)
1138: {
1139: int i;
1.11 noro 1140: UINT r;
1.1 noro 1141:
1142: r = 0;
1143: for ( i = 0; i < nd_wpd; i++ )
1.12 noro 1144: r = (r*1511+d[i]);
1.11 noro 1145: r %= REDTAB_LEN;
1.1 noro 1146: return r;
1147: }
1148:
1149: INLINE int ndl_find_reducer(UINT *dg)
1150: {
1151: RHist r;
1152: int d,k,i;
1153:
1154: d = ndl_hash_value(dg);
1155: for ( r = nd_red[d], k = 0; r; r = NEXT(r), k++ ) {
1156: if ( ndl_equal(dg,DL(r)) ) {
1157: if ( k > 0 ) nd_notfirst++;
1158: nd_found++;
1159: return r->index;
1160: }
1161: }
1162: if ( Reverse )
1163: for ( i = nd_psn-1; i >= 0; i-- ) {
1164: r = nd_psh[i];
1165: if ( ndl_reducible(dg,DL(r)) ) {
1166: nd_create++;
1167: nd_append_red(dg,i);
1168: return i;
1169: }
1170: }
1171: else
1172: for ( i = 0; i < nd_psn; i++ ) {
1173: r = nd_psh[i];
1174: if ( ndl_reducible(dg,DL(r)) ) {
1175: nd_create++;
1176: nd_append_red(dg,i);
1177: return i;
1178: }
1179: }
1180: return -1;
1181: }
1182:
1183: ND nd_merge(ND p1,ND p2)
1184: {
1185: int n,c;
1186: int t,can,td1,td2;
1187: ND r;
1188: NM m1,m2,mr0,mr,s;
1189:
1190: if ( !p1 ) return p2;
1191: else if ( !p2 ) return p1;
1192: else {
1193: can = 0;
1194: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1195: c = DL_COMPARE(DL(m1),DL(m2));
1196: switch ( c ) {
1197: case 0:
1198: s = m1; m1 = NEXT(m1);
1199: can++; NEXTNM2(mr0,mr,s);
1200: s = m2; m2 = NEXT(m2); FREENM(s);
1201: break;
1202: case 1:
1203: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1204: break;
1205: case -1:
1206: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1207: break;
1208: }
1209: }
1210: if ( !mr0 )
1211: if ( m1 ) mr0 = m1;
1212: else if ( m2 ) mr0 = m2;
1213: else return 0;
1214: else if ( m1 ) NEXT(mr) = m1;
1215: else if ( m2 ) NEXT(mr) = m2;
1216: else NEXT(mr) = 0;
1217: BDY(p1) = mr0;
1218: SG(p1) = MAX(SG(p1),SG(p2));
1219: LEN(p1) = LEN(p1)+LEN(p2)-can;
1220: FREEND(p2);
1221: return p1;
1222: }
1223: }
1224:
1225: ND nd_add(int mod,ND p1,ND p2)
1226: {
1227: int n,c;
1228: int t,can,td1,td2;
1229: ND r;
1230: NM m1,m2,mr0,mr,s;
1231:
1.11 noro 1232: Nnd_add++;
1.1 noro 1233: if ( !p1 ) return p2;
1234: else if ( !p2 ) return p1;
1235: else if ( mod == -1 ) return nd_add_sf(p1,p2);
1236: else if ( mod == -2 ) return nd_add_lf(p1,p2);
1237: else if ( !mod ) return nd_add_q(p1,p2);
1238: else {
1239: can = 0;
1240: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1241: c = DL_COMPARE(DL(m1),DL(m2));
1242: switch ( c ) {
1243: case 0:
1244: t = ((CM(m1))+(CM(m2))) - mod;
1245: if ( t < 0 ) t += mod;
1246: s = m1; m1 = NEXT(m1);
1247: if ( t ) {
1248: can++; NEXTNM2(mr0,mr,s); CM(mr) = (t);
1249: } else {
1250: can += 2; FREENM(s);
1251: }
1252: s = m2; m2 = NEXT(m2); FREENM(s);
1253: break;
1254: case 1:
1255: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1256: break;
1257: case -1:
1258: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1259: break;
1260: }
1261: }
1262: if ( !mr0 )
1263: if ( m1 ) mr0 = m1;
1264: else if ( m2 ) mr0 = m2;
1265: else return 0;
1266: else if ( m1 ) NEXT(mr) = m1;
1267: else if ( m2 ) NEXT(mr) = m2;
1268: else NEXT(mr) = 0;
1269: BDY(p1) = mr0;
1270: SG(p1) = MAX(SG(p1),SG(p2));
1271: LEN(p1) = LEN(p1)+LEN(p2)-can;
1272: FREEND(p2);
1273: return p1;
1274: }
1275: }
1276:
1277: /* XXX on opteron, the inlined manipulation of destructive additon of
1278: * two NM seems to make gcc optimizer get confused, so the part is
1279: * done in a function.
1280: */
1281:
1282: int nm_destructive_add_q(NM *m1,NM *m2,NM *mr0,NM *mr)
1283: {
1284: NM s;
1285: P t;
1286: int can;
1287:
1288: addp(nd_vc,CP(*m1),CP(*m2),&t);
1289: s = *m1; *m1 = NEXT(*m1);
1290: if ( t ) {
1291: can = 1; NEXTNM2(*mr0,*mr,s); CP(*mr) = (t);
1292: } else {
1293: can = 2; FREENM(s);
1294: }
1295: s = *m2; *m2 = NEXT(*m2); FREENM(s);
1296: return can;
1297: }
1298:
1299: ND nd_add_q(ND p1,ND p2)
1300: {
1301: int n,c,can;
1302: ND r;
1303: NM m1,m2,mr0,mr,s;
1304: P t;
1305:
1306: if ( !p1 ) return p2;
1307: else if ( !p2 ) return p1;
1308: else {
1309: can = 0;
1310: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1311: c = DL_COMPARE(DL(m1),DL(m2));
1312: switch ( c ) {
1313: case 0:
1314: #if defined(__x86_64__)
1315: can += nm_destructive_add_q(&m1,&m2,&mr0,&mr);
1316: #else
1317: addp(nd_vc,CP(m1),CP(m2),&t);
1318: s = m1; m1 = NEXT(m1);
1319: if ( t ) {
1320: can++; NEXTNM2(mr0,mr,s); CP(mr) = (t);
1321: } else {
1322: can += 2; FREENM(s);
1323: }
1324: s = m2; m2 = NEXT(m2); FREENM(s);
1325: #endif
1326: break;
1327: case 1:
1328: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1329: break;
1330: case -1:
1331: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1332: break;
1333: }
1334: }
1335: if ( !mr0 )
1336: if ( m1 ) mr0 = m1;
1337: else if ( m2 ) mr0 = m2;
1338: else return 0;
1339: else if ( m1 ) NEXT(mr) = m1;
1340: else if ( m2 ) NEXT(mr) = m2;
1341: else NEXT(mr) = 0;
1342: BDY(p1) = mr0;
1343: SG(p1) = MAX(SG(p1),SG(p2));
1344: LEN(p1) = LEN(p1)+LEN(p2)-can;
1345: FREEND(p2);
1346: return p1;
1347: }
1348: }
1349:
1350: ND nd_add_sf(ND p1,ND p2)
1351: {
1352: int n,c,can;
1353: ND r;
1354: NM m1,m2,mr0,mr,s;
1355: int t;
1356:
1357: if ( !p1 ) return p2;
1358: else if ( !p2 ) return p1;
1359: else {
1360: can = 0;
1361: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1362: c = DL_COMPARE(DL(m1),DL(m2));
1363: switch ( c ) {
1364: case 0:
1365: t = _addsf(CM(m1),CM(m2));
1366: s = m1; m1 = NEXT(m1);
1367: if ( t ) {
1368: can++; NEXTNM2(mr0,mr,s); CM(mr) = (t);
1369: } else {
1370: can += 2; FREENM(s);
1371: }
1372: s = m2; m2 = NEXT(m2); FREENM(s);
1373: break;
1374: case 1:
1375: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1376: break;
1377: case -1:
1378: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1379: break;
1380: }
1381: }
1382: if ( !mr0 )
1383: if ( m1 ) mr0 = m1;
1384: else if ( m2 ) mr0 = m2;
1385: else return 0;
1386: else if ( m1 ) NEXT(mr) = m1;
1387: else if ( m2 ) NEXT(mr) = m2;
1388: else NEXT(mr) = 0;
1389: BDY(p1) = mr0;
1390: SG(p1) = MAX(SG(p1),SG(p2));
1391: LEN(p1) = LEN(p1)+LEN(p2)-can;
1392: FREEND(p2);
1393: return p1;
1394: }
1395: }
1396:
1397:
1398: ND nd_reduce2(int mod,ND d,ND g,NDV p,NM mul,NDC dn,Obj *divp)
1399: {
1400: int c,c1,c2;
1401: Z cg,cred,gcd,tq;
1402: P cgp,credp,gcdp;
1403: Obj tr,tr1;
1404:
1405: if ( mod == -1 ) {
1406: CM(mul) = _mulsf(_invsf(HCM(p)),_chsgnsf(HCM(g)));
1407: *divp = (Obj)ONE;
1408: } else if ( mod == -2 ) {
1409: Z inv,t;
1410: divlf(ONE,HCZ(p),&inv);
1411: chsgnlf(HCZ(g),&t);
1412: mullf(inv,t,&CZ(mul));
1413: *divp = (Obj)ONE;
1414: } else if ( mod ) {
1415: c1 = invm(HCM(p),mod); c2 = mod-HCM(g);
1416: DMAR(c1,c2,0,mod,c); CM(mul) = c;
1417: *divp = (Obj)ONE;
1418: } else if ( nd_vc ) {
1419: ezgcdpz(nd_vc,HCP(g),HCP(p),&gcdp);
1420: divsp(nd_vc,HCP(g),gcdp,&cgp); divsp(nd_vc,HCP(p),gcdp,&credp);
1421: chsgnp(cgp,&CP(mul));
1422: nd_mul_c_q(d,credp); nd_mul_c_q(g,credp);
1423: if ( dn ) {
1424: mulr(nd_vc,(Obj)dn->r,(Obj)credp,&tr);
1425: reductr(nd_vc,tr,&tr1); dn->r = (R)tr1;
1426: }
1427: *divp = (Obj)credp;
1428: } else {
1.6 noro 1429: igcd_cofactor(HCZ(g),HCZ(p),&gcd,&cg,&cred);
1430: chsgnz(cg,&CZ(mul));
1.1 noro 1431: nd_mul_c_q(d,(P)cred); nd_mul_c_q(g,(P)cred);
1432: if ( dn ) {
1433: mulz(dn->z,cred,&tq); dn->z = tq;
1434: }
1435: *divp = (Obj)cred;
1436: }
1437: return nd_add(mod,g,ndv_mul_nm(mod,mul,p));
1438: }
1439:
1440: /* ret=1 : success, ret=0 : overflow */
1.6 noro 1441: int nd_nf(int mod,ND d,ND g,NDV *ps,int full,ND *rp)
1.1 noro 1442: {
1443: NM m,mrd,tail;
1444: NM mul;
1445: int n,sugar,psugar,sugar0,stat,index;
1446: int c,c1,c2,dummy;
1447: RHist h;
1448: NDV p,red;
1449: Q cg,cred,gcd,tq,qq;
1450: Z iq;
1451: DP dmul;
1452: NODE node;
1453: LIST hist;
1454: double hmag;
1455: P tp,tp1;
1456: Obj tr,tr1,div;
1457: union oNDC hg;
1458: P cont;
1459:
1460: if ( !g ) {
1461: *rp = d;
1462: return 1;
1463: }
1464: if ( !mod ) hmag = ((double)p_mag(HCP(g)))*nd_scale;
1465:
1466: sugar0 = sugar = SG(g);
1467: n = NV(g);
1468: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
1469: if ( d )
1470: for ( tail = BDY(d); NEXT(tail); tail = NEXT(tail) );
1471: for ( ; g; ) {
1472: index = ndl_find_reducer(HDL(g));
1473: if ( index >= 0 ) {
1474: h = nd_psh[index];
1475: ndl_sub(HDL(g),DL(h),DL(mul));
1476: if ( ndl_check_bound2(index,DL(mul)) ) {
1477: nd_free(g); nd_free(d);
1478: return 0;
1479: }
1480: p = nd_demand ? ndv_load(index) : ps[index];
1481: /* d+g -> div*(d+g)+mul*p */
1.6 noro 1482: g = nd_reduce2(mod,d,g,p,mul,0,&div);
1.1 noro 1483: if ( nd_gentrace ) {
1484: /* Trace=[div,index,mul,ONE] */
1.6 noro 1485: STOZ(index,iq);
1.1 noro 1486: nmtodp(mod,mul,&dmul);
1487: node = mknode(4,div,iq,dmul,ONE);
1488: }
1489: sugar = MAX(sugar,SG(p)+TD(DL(mul)));
1490: if ( !mod && g && !nd_vc && ((double)(p_mag(HCP(g))) > hmag) ) {
1491: hg = HCU(g);
1492: nd_removecont2(d,g);
1.6 noro 1493: if ( nd_gentrace ) {
1.1 noro 1494: /* overwrite cont : Trace=[div,index,mul,cont] */
1.6 noro 1495: /* exact division */
1.1 noro 1496: cont = ndc_div(mod,hg,HCU(g));
1497: if ( nd_gentrace && !UNIQ(cont) ) ARG3(node) = (pointer)cont;
1498: }
1499: hmag = ((double)p_mag(HCP(g)))*nd_scale;
1500: }
1501: MKLIST(hist,node);
1502: MKNODE(node,hist,nd_tracelist); nd_tracelist = node;
1503: } else if ( !full ) {
1504: *rp = g;
1505: return 1;
1506: } else {
1507: m = BDY(g);
1508: if ( NEXT(m) ) {
1509: BDY(g) = NEXT(m); NEXT(m) = 0; LEN(g)--;
1510: } else {
1511: FREEND(g); g = 0;
1512: }
1513: if ( d ) {
1514: NEXT(tail)=m; tail=m; LEN(d)++;
1515: } else {
1516: MKND(n,m,1,d); tail = BDY(d);
1517: }
1518: }
1519: }
1520: if ( d ) SG(d) = sugar;
1521: *rp = d;
1522: return 1;
1523: }
1524:
1525: int nd_nf_pbucket(int mod,ND g,NDV *ps,int full,ND *rp)
1526: {
1527: int hindex,index;
1528: NDV p;
1529: ND u,d,red;
1530: NODE l;
1531: NM mul,m,mrd,tail;
1532: int sugar,psugar,n,h_reducible;
1533: PGeoBucket bucket;
1534: int c,c1,c2;
1535: Z cg,cred,gcd,zzz;
1536: RHist h;
1537: double hmag,gmag;
1538: int count = 0;
1539: int hcount = 0;
1540:
1541: if ( !g ) {
1542: *rp = 0;
1543: return 1;
1544: }
1545: sugar = SG(g);
1546: n = NV(g);
1.6 noro 1547: if ( !mod ) hmag = ((double)p_mag((P)HCZ(g)))*nd_scale;
1.1 noro 1548: bucket = create_pbucket();
1549: add_pbucket(mod,bucket,g);
1550: d = 0;
1551: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
1552: while ( 1 ) {
1553: if ( mod > 0 || mod == -1 )
1554: hindex = head_pbucket(mod,bucket);
1555: else if ( mod == -2 )
1556: hindex = head_pbucket_lf(bucket);
1557: else
1558: hindex = head_pbucket_q(bucket);
1559: if ( hindex < 0 ) {
1560: if ( DP_Print > 3 ) printf("(%d %d)",count,hcount);
1561: if ( d ) SG(d) = sugar;
1562: *rp = d;
1563: return 1;
1564: }
1565: g = bucket->body[hindex];
1566: index = ndl_find_reducer(HDL(g));
1567: if ( index >= 0 ) {
1568: count++;
1569: if ( !d ) hcount++;
1570: h = nd_psh[index];
1571: ndl_sub(HDL(g),DL(h),DL(mul));
1572: if ( ndl_check_bound2(index,DL(mul)) ) {
1573: nd_free(d);
1574: free_pbucket(bucket);
1575: *rp = 0;
1576: return 0;
1577: }
1578: p = ps[index];
1579: if ( mod == -1 )
1580: CM(mul) = _mulsf(_invsf(HCM(p)),_chsgnsf(HCM(g)));
1581: else if ( mod == -2 ) {
1582: Z inv,t;
1583: divlf(ONE,HCZ(p),&inv);
1584: chsgnlf(HCZ(g),&t);
1585: mullf(inv,t,&CZ(mul));
1586: } else if ( mod ) {
1587: c1 = invm(HCM(p),mod); c2 = mod-HCM(g);
1588: DMAR(c1,c2,0,mod,c); CM(mul) = c;
1589: } else {
1.6 noro 1590: igcd_cofactor(HCZ(g),HCZ(p),&gcd,&cg,&cred);
1591: chsgnz(cg,&CZ(mul));
1.1 noro 1592: nd_mul_c_q(d,(P)cred);
1593: mulq_pbucket(bucket,cred);
1594: g = bucket->body[hindex];
1.6 noro 1595: gmag = (double)p_mag((P)HCZ(g));
1.1 noro 1596: }
1597: red = ndv_mul_nm(mod,mul,p);
1598: bucket->body[hindex] = nd_remove_head(g);
1599: red = nd_remove_head(red);
1600: add_pbucket(mod,bucket,red);
1601: psugar = SG(p)+TD(DL(mul));
1602: sugar = MAX(sugar,psugar);
1603: if ( !mod && hmag && (gmag > hmag) ) {
1604: g = normalize_pbucket(mod,bucket);
1605: if ( !g ) {
1606: if ( d ) SG(d) = sugar;
1607: *rp = d;
1608: return 1;
1609: }
1610: nd_removecont2(d,g);
1.6 noro 1611: hmag = ((double)p_mag((P)HCZ(g)))*nd_scale;
1.1 noro 1612: add_pbucket(mod,bucket,g);
1613: }
1614: } else if ( !full ) {
1615: g = normalize_pbucket(mod,bucket);
1616: if ( g ) SG(g) = sugar;
1617: *rp = g;
1618: return 1;
1619: } else {
1620: m = BDY(g);
1621: if ( NEXT(m) ) {
1622: BDY(g) = NEXT(m); NEXT(m) = 0; LEN(g)--;
1623: } else {
1624: FREEND(g); g = 0;
1625: }
1626: bucket->body[hindex] = g;
1627: NEXT(m) = 0;
1628: if ( d ) {
1629: NEXT(tail)=m; tail=m; LEN(d)++;
1630: } else {
1631: MKND(n,m,1,d); tail = BDY(d);
1632: }
1633: }
1634: }
1635: }
1636:
1637: /* input : list of NDV, cand : list of NDV */
1638:
1639: int ndv_check_membership(int m,NODE input,int obpe,int oadv,EPOS oepos,NODE cand)
1640: {
1641: int n,i,stat;
1642: ND nf,d;
1643: NDV r;
1644: NODE t,s;
1645: union oNDC dn;
1646: Z q;
1647: LIST list;
1648:
1649: ndv_setup(m,0,cand,nd_gentrace?1:0,1);
1650: n = length(cand);
1651:
1652: if ( nd_gentrace ) { nd_alltracelist = 0; nd_tracelist = 0; }
1653: /* membercheck : list is a subset of Id(cand) ? */
1654: for ( t = input, i = 0; t; t = NEXT(t), i++ ) {
1655: again:
1656: nd_tracelist = 0;
1657: if ( nd_bpe > obpe )
1658: r = ndv_dup_realloc((NDV)BDY(t),obpe,oadv,oepos);
1659: else
1660: r = (NDV)BDY(t);
1661: #if 0
1662: // moved to nd_f4_lf_trace()
1663: if ( m == -2 ) ndv_mod(m,r);
1664: #endif
1665: d = ndvtond(m,r);
1.6 noro 1666: stat = nd_nf(m,0,d,nd_ps,0,&nf);
1.1 noro 1667: if ( !stat ) {
1668: nd_reconstruct(0,0);
1669: goto again;
1670: } else if ( nf ) return 0;
1671: if ( nd_gentrace ) {
1672: nd_tracelist = reverse_node(nd_tracelist);
1673: MKLIST(list,nd_tracelist);
1.6 noro 1674: STOZ(i,q); s = mknode(2,q,list); MKLIST(list,s);
1.1 noro 1675: MKNODE(s,list,nd_alltracelist);
1676: nd_alltracelist = s; nd_tracelist = 0;
1677: }
1678: if ( DP_Print ) { printf("."); fflush(stdout); }
1679: }
1680: if ( DP_Print ) { printf("\n"); }
1681: return 1;
1682: }
1683:
1684: ND nd_remove_head(ND p)
1685: {
1686: NM m;
1687:
1688: m = BDY(p);
1689: if ( !NEXT(m) ) {
1690: FREEND(p); p = 0;
1691: } else {
1692: BDY(p) = NEXT(m); LEN(p)--;
1693: }
1694: FREENM(m);
1695: return p;
1696: }
1697:
1698: ND nd_separate_head(ND p,ND *head)
1699: {
1700: NM m,m0;
1701: ND r;
1702:
1703: m = BDY(p);
1704: if ( !NEXT(m) ) {
1705: *head = p; p = 0;
1706: } else {
1707: m0 = m;
1708: BDY(p) = NEXT(m); LEN(p)--;
1709: NEXT(m0) = 0;
1710: MKND(NV(p),m0,1,r);
1711: *head = r;
1712: }
1713: return p;
1714: }
1715:
1716: PGeoBucket create_pbucket()
1717: {
1718: PGeoBucket g;
1719:
1720: g = CALLOC(1,sizeof(struct oPGeoBucket));
1721: g->m = -1;
1722: return g;
1723: }
1724:
1725: void free_pbucket(PGeoBucket b) {
1726: int i;
1727:
1728: for ( i = 0; i <= b->m; i++ )
1729: if ( b->body[i] ) {
1730: nd_free(b->body[i]);
1731: b->body[i] = 0;
1732: }
1733: GCFREE(b);
1734: }
1735:
1736: void add_pbucket_symbolic(PGeoBucket g,ND d)
1737: {
1738: int l,i,k,m;
1739:
1740: if ( !d )
1741: return;
1742: l = LEN(d);
1743: for ( k = 0, m = 1; l > m; k++, m <<= 1 );
1744: /* 2^(k-1) < l <= 2^k (=m) */
1745: d = nd_merge(g->body[k],d);
1746: for ( ; d && LEN(d) > m; k++, m <<= 1 ) {
1747: g->body[k] = 0;
1748: d = nd_merge(g->body[k+1],d);
1749: }
1750: g->body[k] = d;
1751: g->m = MAX(g->m,k);
1752: }
1753:
1754: void add_pbucket(int mod,PGeoBucket g,ND d)
1755: {
1756: int l,i,k,m;
1757:
1758: if ( !d )
1759: return;
1760: l = LEN(d);
1761: for ( k = 0, m = 1; l > m; k++, m <<= 1 );
1762: /* 2^(k-1) < l <= 2^k (=m) */
1763: d = nd_add(mod,g->body[k],d);
1764: for ( ; d && LEN(d) > m; k++, m <<= 1 ) {
1765: g->body[k] = 0;
1766: d = nd_add(mod,g->body[k+1],d);
1767: }
1768: g->body[k] = d;
1769: g->m = MAX(g->m,k);
1770: }
1771:
1772: void mulq_pbucket(PGeoBucket g,Z c)
1773: {
1774: int k;
1775:
1776: for ( k = 0; k <= g->m; k++ )
1777: nd_mul_c_q(g->body[k],(P)c);
1778: }
1779:
1780: NM remove_head_pbucket_symbolic(PGeoBucket g)
1781: {
1782: int j,i,k,c;
1783: NM head;
1784:
1785: k = g->m;
1786: j = -1;
1787: for ( i = 0; i <= k; i++ ) {
1788: if ( !g->body[i] ) continue;
1789: if ( j < 0 ) j = i;
1790: else {
1791: c = DL_COMPARE(HDL(g->body[i]),HDL(g->body[j]));
1792: if ( c > 0 )
1793: j = i;
1794: else if ( c == 0 )
1795: g->body[i] = nd_remove_head(g->body[i]);
1796: }
1797: }
1798: if ( j < 0 ) return 0;
1799: else {
1800: head = BDY(g->body[j]);
1801: if ( !NEXT(head) ) {
1802: FREEND(g->body[j]);
1803: g->body[j] = 0;
1804: } else {
1805: BDY(g->body[j]) = NEXT(head);
1806: LEN(g->body[j])--;
1807: }
1808: return head;
1809: }
1810: }
1811:
1812: int head_pbucket(int mod,PGeoBucket g)
1813: {
1814: int j,i,c,k,nv,sum;
1815: UINT *di,*dj;
1816: ND gi,gj;
1817:
1818: k = g->m;
1819: while ( 1 ) {
1820: j = -1;
1821: for ( i = 0; i <= k; i++ ) {
1822: if ( !(gi = g->body[i]) )
1823: continue;
1824: if ( j < 0 ) {
1825: j = i;
1826: gj = g->body[j];
1827: dj = HDL(gj);
1828: sum = HCM(gj);
1829: } else {
1830: c = DL_COMPARE(HDL(gi),dj);
1831: if ( c > 0 ) {
1832: if ( sum ) HCM(gj) = sum;
1833: else g->body[j] = nd_remove_head(gj);
1834: j = i;
1835: gj = g->body[j];
1836: dj = HDL(gj);
1837: sum = HCM(gj);
1838: } else if ( c == 0 ) {
1839: if ( mod == -1 )
1840: sum = _addsf(sum,HCM(gi));
1841: else {
1842: sum = sum+HCM(gi)-mod;
1843: if ( sum < 0 ) sum += mod;
1844: }
1845: g->body[i] = nd_remove_head(gi);
1846: }
1847: }
1848: }
1849: if ( j < 0 ) return -1;
1850: else if ( sum ) {
1851: HCM(gj) = sum;
1852: return j;
1853: } else
1854: g->body[j] = nd_remove_head(gj);
1855: }
1856: }
1857:
1858: int head_pbucket_q(PGeoBucket g)
1859: {
1860: int j,i,c,k,nv;
1861: Z sum,t;
1862: ND gi,gj;
1863:
1864: k = g->m;
1865: while ( 1 ) {
1866: j = -1;
1867: for ( i = 0; i <= k; i++ ) {
1868: if ( !(gi = g->body[i]) ) continue;
1869: if ( j < 0 ) {
1870: j = i;
1871: gj = g->body[j];
1.6 noro 1872: sum = HCZ(gj);
1.1 noro 1873: } else {
1874: nv = NV(gi);
1875: c = DL_COMPARE(HDL(gi),HDL(gj));
1876: if ( c > 0 ) {
1.6 noro 1877: if ( sum ) HCZ(gj) = sum;
1.1 noro 1878: else g->body[j] = nd_remove_head(gj);
1879: j = i;
1880: gj = g->body[j];
1.6 noro 1881: sum = HCZ(gj);
1.1 noro 1882: } else if ( c == 0 ) {
1.6 noro 1883: addz(sum,HCZ(gi),&t);
1.1 noro 1884: sum = t;
1885: g->body[i] = nd_remove_head(gi);
1886: }
1887: }
1888: }
1889: if ( j < 0 ) return -1;
1890: else if ( sum ) {
1.6 noro 1891: HCZ(gj) = sum;
1.1 noro 1892: return j;
1893: } else
1894: g->body[j] = nd_remove_head(gj);
1895: }
1896: }
1897:
1898: int head_pbucket_lf(PGeoBucket g)
1899: {
1900: int j,i,c,k,nv;
1901: Z sum,t;
1902: ND gi,gj;
1903:
1904: k = g->m;
1905: while ( 1 ) {
1906: j = -1;
1907: for ( i = 0; i <= k; i++ ) {
1908: if ( !(gi = g->body[i]) ) continue;
1909: if ( j < 0 ) {
1910: j = i;
1911: gj = g->body[j];
1912: sum = HCZ(gj);
1913: } else {
1914: nv = NV(gi);
1915: c = DL_COMPARE(HDL(gi),HDL(gj));
1916: if ( c > 0 ) {
1917: if ( sum ) HCZ(gj) = sum;
1918: else g->body[j] = nd_remove_head(gj);
1919: j = i;
1920: gj = g->body[j];
1921: sum = HCZ(gj);
1922: } else if ( c == 0 ) {
1923: addlf(sum,HCZ(gi),&t);
1924: sum = t;
1925: g->body[i] = nd_remove_head(gi);
1926: }
1927: }
1928: }
1929: if ( j < 0 ) return -1;
1930: else if ( sum ) {
1931: HCZ(gj) = sum;
1932: return j;
1933: } else
1934: g->body[j] = nd_remove_head(gj);
1935: }
1936: }
1937:
1938: ND normalize_pbucket(int mod,PGeoBucket g)
1939: {
1940: int i;
1941: ND r,t;
1942:
1943: r = 0;
1944: for ( i = 0; i <= g->m; i++ ) {
1945: r = nd_add(mod,r,g->body[i]);
1946: g->body[i] = 0;
1947: }
1948: g->m = -1;
1949: return r;
1950: }
1951:
1952: #if 0
1953: void register_hcf(NDV p)
1954: {
1955: DCP dc,t;
1956: P hc,h;
1957: int c;
1958: NODE l,l1,prev;
1959:
1960: hc = p->body->c.p;
1961: if ( !nd_vc || NUM(hc) ) return;
1962: fctrp(nd_vc,hc,&dc);
1963: for ( t = dc; t; t = NEXT(t) ) {
1964: h = t->c;
1965: if ( NUM(h) ) continue;
1966: for ( prev = 0, l = nd_hcf; l; prev = l, l = NEXT(l) ) {
1967: c = compp(nd_vc,h,(P)BDY(l));
1968: if ( c >= 0 ) break;
1969: }
1970: if ( !l || c > 0 ) {
1971: MKNODE(l1,h,l);
1972: if ( !prev )
1973: nd_hcf = l1;
1974: else
1975: NEXT(prev) = l1;
1976: }
1977: }
1978: }
1979: #else
1980: void register_hcf(NDV p)
1981: {
1982: DCP dc,t;
1983: P hc,h,q;
1984: Q dmy;
1985: int c;
1986: NODE l,l1,prev;
1987:
1988: hc = p->body->c.p;
1989: if ( NUM(hc) ) return;
1990: ptozp(hc,1,&dmy,&h);
1991: #if 1
1992: for ( l = nd_hcf; l; l = NEXT(l) ) {
1993: while ( 1 ) {
1994: if ( divtpz(nd_vc,h,(P)BDY(l),&q) ) h = q;
1995: else break;
1996: }
1997: }
1998: if ( NUM(h) ) return;
1999: #endif
2000: for ( prev = 0, l = nd_hcf; l; prev = l, l = NEXT(l) ) {
2001: c = compp(nd_vc,h,(P)BDY(l));
2002: if ( c >= 0 ) break;
2003: }
2004: if ( !l || c > 0 ) {
2005: MKNODE(l1,h,l);
2006: if ( !prev )
2007: nd_hcf = l1;
2008: else
2009: NEXT(prev) = l1;
2010: }
2011: }
2012: #endif
2013:
2014: int do_diagonalize(int sugar,int m)
2015: {
1.6 noro 2016: int i,nh,stat;
2017: NODE r,g,t;
2018: ND h,nf,s,head;
2019: NDV nfv;
2020: Q q;
2021: P nm,nmp,dn,mnp,dnp,cont,cont1;
2022: union oNDC hc;
2023: NODE node;
2024: LIST l;
2025: Z iq;
1.1 noro 2026:
1.6 noro 2027: for ( i = nd_psn-1; i >= 0 && SG(nd_psh[i]) == sugar; i-- ) {
2028: if ( nd_gentrace ) {
2029: /* Trace = [1,index,1,1] */
2030: STOZ(i,iq); node = mknode(4,ONE,iq,ONE,ONE);
2031: MKLIST(l,node); MKNODE(nd_tracelist,l,0);
2032: }
2033: if ( nd_demand )
2034: nfv = ndv_load(i);
2035: else
2036: nfv = nd_ps[i];
2037: s = ndvtond(m,nfv);
2038: s = nd_separate_head(s,&head);
2039: stat = nd_nf(m,head,s,nd_ps,1,&nf);
2040: if ( !stat ) return 0;
2041: ndv_free(nfv);
2042: hc = HCU(nf); nd_removecont(m,nf);
2043: /* exact division */
2044: cont = ndc_div(m,hc,HCU(nf));
1.1 noro 2045: if ( nd_gentrace ) finalize_tracelist(i,cont);
1.6 noro 2046: nfv = ndtondv(m,nf);
2047: nd_free(nf);
2048: nd_bound[i] = ndv_compute_bound(nfv);
2049: if ( !m ) register_hcf(nfv);
2050: if ( nd_demand ) {
2051: ndv_save(nfv,i);
2052: ndv_free(nfv);
2053: } else
2054: nd_ps[i] = nfv;
2055: }
2056: return 1;
1.1 noro 2057: }
2058:
2059: LIST compute_splist()
2060: {
2061: NODE g,tn0,tn,node;
2062: LIST l0;
2063: ND_pairs d,t;
2064: int i;
2065: Z i1,i2;
2066:
2067: g = 0; d = 0;
2068: for ( i = 0; i < nd_psn; i++ ) {
2069: d = update_pairs(d,g,i,0);
2070: g = update_base(g,i);
2071: }
2072: for ( t = d, tn0 = 0; t; t = NEXT(t) ) {
2073: NEXTNODE(tn0,tn);
1.6 noro 2074: STOZ(t->i1,i1); STOZ(t->i2,i2);
1.1 noro 2075: node = mknode(2,i1,i2); MKLIST(l0,node);
2076: BDY(tn) = l0;
2077: }
2078: if ( tn0 ) NEXT(tn) = 0; MKLIST(l0,tn0);
2079: return l0;
2080: }
2081:
2082: /* return value = 0 => input is not a GB */
2083:
2084: NODE nd_gb(int m,int ishomo,int checkonly,int gensyz,int **indp)
2085: {
1.6 noro 2086: int i,nh,sugar,stat;
2087: NODE r,g,t;
2088: ND_pairs d;
2089: ND_pairs l;
2090: ND h,nf,s,head,nf1;
2091: NDV nfv;
2092: Z q;
2093: union oNDC dn,hc;
2094: int diag_count = 0;
2095: P cont;
2096: LIST list;
2097:
1.11 noro 2098: Nnd_add = 0;
1.6 noro 2099: g = 0; d = 0;
2100: for ( i = 0; i < nd_psn; i++ ) {
2101: d = update_pairs(d,g,i,gensyz);
2102: g = update_base(g,i);
2103: }
2104: sugar = 0;
2105: while ( d ) {
1.1 noro 2106: again:
1.6 noro 2107: l = nd_minp(d,&d);
2108: if ( MaxDeg > 0 && SG(l) > MaxDeg ) break;
2109: if ( SG(l) != sugar ) {
2110: if ( ishomo ) {
2111: diag_count = 0;
2112: stat = do_diagonalize(sugar,m);
1.1 noro 2113: if ( !stat ) {
1.6 noro 2114: NEXT(l) = d; d = l;
2115: d = nd_reconstruct(0,d);
2116: goto again;
1.1 noro 2117: }
1.6 noro 2118: }
2119: sugar = SG(l);
2120: if ( DP_Print ) fprintf(asir_out,"%d",sugar);
2121: }
2122: stat = nd_sp(m,0,l,&h);
2123: if ( !stat ) {
2124: NEXT(l) = d; d = l;
2125: d = nd_reconstruct(0,d);
2126: goto again;
2127: }
1.1 noro 2128: #if USE_GEOBUCKET
1.6 noro 2129: stat = (m&&!nd_gentrace)?nd_nf_pbucket(m,h,nd_ps,!Top,&nf)
2130: :nd_nf(m,0,h,nd_ps,!Top,&nf);
1.1 noro 2131: #else
1.6 noro 2132: stat = nd_nf(m,0,h,nd_ps,!Top,&nf);
1.1 noro 2133: #endif
1.6 noro 2134: if ( !stat ) {
2135: NEXT(l) = d; d = l;
2136: d = nd_reconstruct(0,d);
2137: goto again;
2138: } else if ( nf ) {
2139: if ( checkonly || gensyz ) return 0;
1.1 noro 2140: if ( nd_newelim ) {
2141: if ( nd_module ) {
2142: if ( MPOS(HDL(nf)) > 1 ) return 0;
2143: } else if ( !(HDL(nf)[nd_exporigin] & nd_mask[0]) ) return 0;
2144: }
1.6 noro 2145: if ( DP_Print ) { printf("+"); fflush(stdout); }
2146: hc = HCU(nf);
2147: nd_removecont(m,nf);
2148: if ( !m && nd_nalg ) {
2149: nd_monic(0,&nf);
2150: nd_removecont(m,nf);
2151: }
2152: if ( nd_gentrace ) {
2153: /* exact division */
1.1 noro 2154: cont = ndc_div(m,hc,HCU(nf));
2155: if ( m || !UNIQ(cont) ) {
1.6 noro 2156: t = mknode(4,NULLP,NULLP,NULLP,cont);
2157: MKLIST(list,t); MKNODE(t,list,nd_tracelist);
1.1 noro 2158: nd_tracelist = t;
2159: }
2160: }
1.6 noro 2161: nfv = ndtondv(m,nf); nd_free(nf);
2162: nh = ndv_newps(m,nfv,0,0);
2163: if ( !m && (ishomo && ++diag_count == diag_period) ) {
2164: diag_count = 0;
2165: stat = do_diagonalize(sugar,m);
2166: if ( !stat ) {
2167: NEXT(l) = d; d = l;
2168: d = nd_reconstruct(1,d);
2169: goto again;
1.1 noro 2170: }
1.6 noro 2171: }
2172: d = update_pairs(d,g,nh,0);
2173: g = update_base(g,nh);
2174: FREENDP(l);
2175: } else {
2176: if ( nd_gentrace && gensyz ) {
2177: nd_tracelist = reverse_node(nd_tracelist);
2178: MKLIST(list,nd_tracelist);
2179: STOZ(-1,q); t = mknode(2,q,list); MKLIST(list,t);
2180: MKNODE(t,list,nd_alltracelist);
2181: nd_alltracelist = t; nd_tracelist = 0;
2182: }
2183: if ( DP_Print ) { printf("."); fflush(stdout); }
2184: FREENDP(l);
2185: }
2186: }
2187: conv_ilist(nd_demand,0,g,indp);
1.11 noro 2188: if ( !checkonly && DP_Print ) { printf("nd_gb done. Number of nd_add=%d\n",Nnd_add); fflush(stdout); }
1.1 noro 2189: return g;
2190: }
2191:
2192: /* splist = [[i1,i2],...] */
2193:
2194: int check_splist(int m,NODE splist)
2195: {
2196: NODE t,p;
2197: ND_pairs d,r,l;
2198: int stat;
2199: ND h,nf;
2200:
2201: for ( d = 0, t = splist; t; t = NEXT(t) ) {
2202: p = BDY((LIST)BDY(t));
1.6 noro 2203: NEXTND_pairs(d,r);
2204: r->i1 = ZTOS((Q)ARG0(p)); r->i2 = ZTOS((Q)ARG1(p));
2205: ndl_lcm(DL(nd_psh[r->i1]),DL(nd_psh[r->i2]),r->lcm);
1.1 noro 2206: SG(r) = TD(LCM(r)); /* XXX */
2207: }
2208: if ( d ) NEXT(r) = 0;
2209:
1.6 noro 2210: while ( d ) {
1.1 noro 2211: again:
1.6 noro 2212: l = nd_minp(d,&d);
2213: stat = nd_sp(m,0,l,&h);
2214: if ( !stat ) {
2215: NEXT(l) = d; d = l;
2216: d = nd_reconstruct(0,d);
2217: goto again;
2218: }
2219: stat = nd_nf(m,0,h,nd_ps,!Top,&nf);
2220: if ( !stat ) {
2221: NEXT(l) = d; d = l;
2222: d = nd_reconstruct(0,d);
2223: goto again;
2224: } else if ( nf ) return 0;
1.1 noro 2225: if ( DP_Print) { printf("."); fflush(stdout); }
1.6 noro 2226: }
1.1 noro 2227: if ( DP_Print) { printf("done.\n"); fflush(stdout); }
2228: return 1;
2229: }
2230:
2231: int check_splist_f4(int m,NODE splist)
2232: {
2233: UINT *s0vect;
1.6 noro 2234: PGeoBucket bucket;
1.1 noro 2235: NODE p,rp0,t;
2236: ND_pairs d,r,l,ll;
2237: int col,stat;
2238:
2239: for ( d = 0, t = splist; t; t = NEXT(t) ) {
2240: p = BDY((LIST)BDY(t));
1.6 noro 2241: NEXTND_pairs(d,r);
2242: r->i1 = ZTOS((Q)ARG0(p)); r->i2 = ZTOS((Q)ARG1(p));
2243: ndl_lcm(DL(nd_psh[r->i1]),DL(nd_psh[r->i2]),r->lcm);
1.1 noro 2244: SG(r) = TD(LCM(r)); /* XXX */
2245: }
2246: if ( d ) NEXT(r) = 0;
2247:
1.6 noro 2248: while ( d ) {
2249: l = nd_minsugarp(d,&d);
2250: bucket = create_pbucket();
2251: stat = nd_sp_f4(m,0,l,bucket);
2252: if ( !stat ) {
2253: for ( ll = l; NEXT(ll); ll = NEXT(ll) );
2254: NEXT(ll) = d; d = l;
2255: d = nd_reconstruct(0,d);
2256: continue;
2257: }
2258: if ( bucket->m < 0 ) continue;
2259: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
2260: if ( !col ) {
2261: for ( ll = l; NEXT(ll); ll = NEXT(ll) );
2262: NEXT(ll) = d; d = l;
2263: d = nd_reconstruct(0,d);
2264: continue;
1.1 noro 2265: }
1.6 noro 2266: if ( nd_f4_red(m,l,0,s0vect,col,rp0,0) ) return 0;
2267: }
2268: return 1;
1.1 noro 2269: }
2270:
2271: int do_diagonalize_trace(int sugar,int m)
2272: {
1.6 noro 2273: int i,nh,stat;
2274: NODE r,g,t;
2275: ND h,nf,nfq,s,head;
2276: NDV nfv,nfqv;
2277: Q q,den,num;
2278: union oNDC hc;
2279: NODE node;
2280: LIST l;
2281: Z iq;
2282: P cont,cont1;
1.1 noro 2283:
1.6 noro 2284: for ( i = nd_psn-1; i >= 0 && SG(nd_psh[i]) == sugar; i-- ) {
2285: if ( nd_gentrace ) {
2286: /* Trace = [1,index,1,1] */
2287: STOZ(i,iq); node = mknode(4,ONE,iq,ONE,ONE);
2288: MKLIST(l,node); MKNODE(nd_tracelist,l,0);
2289: }
2290: /* for nd_ps */
2291: s = ndvtond(m,nd_ps[i]);
2292: s = nd_separate_head(s,&head);
2293: stat = nd_nf_pbucket(m,s,nd_ps,1,&nf);
2294: if ( !stat ) return 0;
2295: nf = nd_add(m,head,nf);
2296: ndv_free(nd_ps[i]);
2297: nd_ps[i] = ndtondv(m,nf);
2298: nd_free(nf);
2299:
2300: /* for nd_ps_trace */
2301: if ( nd_demand )
2302: nfv = ndv_load(i);
2303: else
2304: nfv = nd_ps_trace[i];
2305: s = ndvtond(0,nfv);
2306: s = nd_separate_head(s,&head);
2307: stat = nd_nf(0,head,s,nd_ps_trace,1,&nf);
2308: if ( !stat ) return 0;
2309: ndv_free(nfv);
2310: hc = HCU(nf); nd_removecont(0,nf);
2311: /* exact division */
1.1 noro 2312: cont = ndc_div(0,hc,HCU(nf));
1.6 noro 2313: if ( nd_gentrace ) finalize_tracelist(i,cont);
2314: nfv = ndtondv(0,nf);
2315: nd_free(nf);
2316: nd_bound[i] = ndv_compute_bound(nfv);
2317: register_hcf(nfv);
2318: if ( nd_demand ) {
2319: ndv_save(nfv,i);
2320: ndv_free(nfv);
2321: } else
2322: nd_ps_trace[i] = nfv;
2323: }
2324: return 1;
1.1 noro 2325: }
2326:
2327: static struct oEGT eg_invdalg;
2328: struct oEGT eg_le;
2329:
2330: void nd_subst_vector(VL vl,P p,NODE subst,P *r)
2331: {
2332: NODE tn;
2333: P p1;
2334:
2335: for ( tn = subst; tn; tn = NEXT(NEXT(tn)) ) {
2336: substp(vl,p,BDY(tn),BDY(NEXT(tn)),&p1); p = p1;
2337: }
2338: *r = p;
2339: }
2340:
2341: NODE nd_gb_trace(int m,int ishomo,int **indp)
2342: {
1.6 noro 2343: int i,nh,sugar,stat;
2344: NODE r,g,t;
2345: ND_pairs d;
2346: ND_pairs l;
2347: ND h,nf,nfq,s,head;
2348: NDV nfv,nfqv;
2349: Z q,den,num;
2350: P hc;
2351: union oNDC dn,hnfq;
2352: struct oEGT eg_monic,egm0,egm1;
2353: int diag_count = 0;
2354: P cont;
2355: LIST list;
2356:
2357: init_eg(&eg_monic);
2358: init_eg(&eg_invdalg);
2359: init_eg(&eg_le);
2360: g = 0; d = 0;
2361: for ( i = 0; i < nd_psn; i++ ) {
2362: d = update_pairs(d,g,i,0);
2363: g = update_base(g,i);
2364: }
2365: sugar = 0;
2366: while ( d ) {
1.1 noro 2367: again:
1.6 noro 2368: l = nd_minp(d,&d);
2369: if ( MaxDeg > 0 && SG(l) > MaxDeg ) break;
2370: if ( SG(l) != sugar ) {
1.1 noro 2371: #if 1
1.6 noro 2372: if ( ishomo ) {
2373: if ( DP_Print > 2 ) fprintf(asir_out,"|");
2374: stat = do_diagonalize_trace(sugar,m);
2375: if ( DP_Print > 2 ) fprintf(asir_out,"|");
2376: diag_count = 0;
1.1 noro 2377: if ( !stat ) {
1.6 noro 2378: NEXT(l) = d; d = l;
2379: d = nd_reconstruct(1,d);
2380: goto again;
1.1 noro 2381: }
1.6 noro 2382: }
2383: #endif
2384: sugar = SG(l);
2385: if ( DP_Print ) fprintf(asir_out,"%d",sugar);
2386: }
2387: stat = nd_sp(m,0,l,&h);
2388: if ( !stat ) {
2389: NEXT(l) = d; d = l;
2390: d = nd_reconstruct(1,d);
2391: goto again;
2392: }
1.1 noro 2393: #if USE_GEOBUCKET
1.6 noro 2394: stat = nd_nf_pbucket(m,h,nd_ps,!Top,&nf);
1.1 noro 2395: #else
1.6 noro 2396: stat = nd_nf(m,0,h,nd_ps,!Top,&nf);
1.1 noro 2397: #endif
1.6 noro 2398: if ( !stat ) {
2399: NEXT(l) = d; d = l;
2400: d = nd_reconstruct(1,d);
2401: goto again;
2402: } else if ( nf ) {
2403: if ( nd_demand ) {
2404: nfqv = ndv_load(nd_psn);
2405: nfq = ndvtond(0,nfqv);
2406: } else
2407: nfq = 0;
2408: if ( !nfq ) {
2409: if ( !nd_sp(0,1,l,&h) || !nd_nf(0,0,h,nd_ps_trace,!Top,&nfq) ) {
2410: NEXT(l) = d; d = l;
2411: d = nd_reconstruct(1,d);
2412: goto again;
2413: }
2414: }
2415: if ( nfq ) {
2416: /* m|HC(nfq) => failure */
2417: if ( nd_vc ) {
2418: nd_subst_vector(nd_vc,HCP(nfq),nd_subst,&hc); q = (Z)hc;
2419: } else
2420: q = HCZ(nfq);
2421: if ( !remqi((Q)q,m) ) return 0;
2422:
2423: if ( DP_Print ) { printf("+"); fflush(stdout); }
2424: hnfq = HCU(nfq);
2425: if ( nd_nalg ) {
2426: /* m|DN(HC(nf)^(-1)) => failure */
2427: get_eg(&egm0);
2428: if ( !nd_monic(m,&nfq) ) return 0;
2429: get_eg(&egm1); add_eg(&eg_monic,&egm0,&egm1);
2430: nd_removecont(0,nfq); nfqv = ndtondv(0,nfq); nd_free(nfq);
2431: nfv = ndv_dup(0,nfqv); ndv_mod(m,nfv); nd_free(nf);
2432: } else {
2433: nd_removecont(0,nfq); nfqv = ndtondv(0,nfq); nd_free(nfq);
2434: nd_removecont(m,nf); nfv = ndtondv(m,nf); nd_free(nf);
2435: }
2436: if ( nd_gentrace ) {
2437: /* exact division */
2438: cont = ndc_div(0,hnfq,HCU(nfqv));
2439: if ( !UNIQ(cont) ) {
2440: t = mknode(4,NULLP,NULLP,NULLP,cont);
2441: MKLIST(list,t); MKNODE(t,list,nd_tracelist);
2442: nd_tracelist = t;
2443: }
2444: }
2445: nh = ndv_newps(0,nfv,nfqv,0);
2446: if ( ishomo && ++diag_count == diag_period ) {
2447: diag_count = 0;
2448: if ( DP_Print > 2 ) fprintf(asir_out,"|");
2449: stat = do_diagonalize_trace(sugar,m);
2450: if ( DP_Print > 2 ) fprintf(asir_out,"|");
2451: if ( !stat ) {
1.1 noro 2452: NEXT(l) = d; d = l;
2453: d = nd_reconstruct(1,d);
2454: goto again;
1.6 noro 2455: }
1.1 noro 2456: }
1.6 noro 2457: d = update_pairs(d,g,nh,0);
2458: g = update_base(g,nh);
2459: } else {
2460: if ( DP_Print ) { printf("*"); fflush(stdout); }
2461: }
2462: } else {
2463: if ( DP_Print ) { printf("."); fflush(stdout); }
1.1 noro 2464: }
1.6 noro 2465: FREENDP(l);
2466: }
2467: if ( nd_nalg ) {
2468: if ( DP_Print ) {
2469: print_eg("monic",&eg_monic);
2470: print_eg("invdalg",&eg_invdalg);
2471: print_eg("le",&eg_le);
1.1 noro 2472: }
1.6 noro 2473: }
1.1 noro 2474: conv_ilist(nd_demand,1,g,indp);
1.6 noro 2475: if ( DP_Print ) { printf("nd_gb_trace done.\n"); fflush(stdout); }
2476: return g;
1.1 noro 2477: }
2478:
2479: int ndv_compare(NDV *p1,NDV *p2)
2480: {
2481: return DL_COMPARE(HDL(*p1),HDL(*p2));
2482: }
2483:
2484: int ndv_compare_rev(NDV *p1,NDV *p2)
2485: {
2486: return -DL_COMPARE(HDL(*p1),HDL(*p2));
2487: }
2488:
2489: int ndvi_compare(NDVI p1,NDVI p2)
2490: {
2491: return DL_COMPARE(HDL(p1->p),HDL(p2->p));
2492: }
2493:
2494: int ndvi_compare_rev(NDVI p1,NDVI p2)
2495: {
2496: return -DL_COMPARE(HDL(p1->p),HDL(p2->p));
2497: }
2498:
2499: NODE ndv_reduceall(int m,NODE f)
2500: {
2501: int i,j,n,stat;
2502: ND nf,g,head;
2503: NODE t,a0,a;
2504: union oNDC dn;
2505: Q q,num,den;
2506: NODE node;
2507: LIST l;
2508: Z iq,jq;
2509: int *perm;
2510: union oNDC hc;
2511: P cont,cont1;
2512:
2513: if ( nd_nora ) return f;
2514: n = length(f);
2515: ndv_setup(m,0,f,0,1);
2516: perm = (int *)MALLOC(n*sizeof(int));
2517: if ( nd_gentrace ) {
2518: for ( t = nd_tracelist, i = 0; i < n; i++, t = NEXT(t) )
1.6 noro 2519: perm[i] = ZTOS((Q)ARG1(BDY((LIST)BDY(t))));
1.1 noro 2520: }
2521: for ( i = 0; i < n; ) {
2522: if ( nd_gentrace ) {
2523: /* Trace = [1,index,1,1] */
1.6 noro 2524: STOZ(i,iq); node = mknode(4,ONE,iq,ONE,ONE);
1.1 noro 2525: MKLIST(l,node); MKNODE(nd_tracelist,l,0);
2526: }
2527: g = ndvtond(m,nd_ps[i]);
2528: g = nd_separate_head(g,&head);
1.6 noro 2529: stat = nd_nf(m,head,g,nd_ps,1,&nf);
1.1 noro 2530: if ( !stat )
2531: nd_reconstruct(0,0);
2532: else {
2533: if ( DP_Print ) { printf("."); fflush(stdout); }
2534: ndv_free(nd_ps[i]);
2535: hc = HCU(nf); nd_removecont(m,nf);
2536: if ( nd_gentrace ) {
2537: for ( t = nd_tracelist; t; t = NEXT(t) ) {
1.6 noro 2538: jq = ARG1(BDY((LIST)BDY(t))); j = ZTOS(jq);
2539: STOZ(perm[j],jq); ARG1(BDY((LIST)BDY(t))) = jq;
1.1 noro 2540: }
1.6 noro 2541: /* exact division */
1.1 noro 2542: cont = ndc_div(m,hc,HCU(nf));
2543: finalize_tracelist(perm[i],cont);
2544: }
2545: nd_ps[i] = ndtondv(m,nf); nd_free(nf);
2546: nd_bound[i] = ndv_compute_bound(nd_ps[i]);
2547: i++;
2548: }
2549: }
2550: if ( DP_Print ) { printf("\n"); }
2551: for ( a0 = 0, i = 0; i < n; i++ ) {
2552: NEXTNODE(a0,a);
2553: if ( !nd_gentrace ) BDY(a) = (pointer)nd_ps[i];
2554: else {
2555: for ( j = 0; j < n; j++ ) if ( perm[j] == i ) break;
2556: BDY(a) = (pointer)nd_ps[j];
2557: }
2558: }
2559: NEXT(a) = 0;
2560: return a0;
2561: }
2562:
2563: ND_pairs update_pairs( ND_pairs d, NODE /* of index */ g, int t, int gensyz)
2564: {
2565: ND_pairs d1,nd,cur,head,prev,remove;
2566:
2567: if ( !g ) return d;
2568: /* for testing */
2569: if ( gensyz && nd_gensyz == 2 ) {
2570: d1 = nd_newpairs(g,t);
2571: if ( !d )
2572: return d1;
2573: else {
2574: nd = d;
2575: while ( NEXT(nd) ) nd = NEXT(nd);
2576: NEXT(nd) = d1;
2577: return d;
2578: }
2579: }
2580: d = crit_B(d,t);
2581: d1 = nd_newpairs(g,t);
2582: d1 = crit_M(d1);
2583: d1 = crit_F(d1);
2584: if ( gensyz || do_weyl )
2585: head = d1;
2586: else {
2587: prev = 0; cur = head = d1;
2588: while ( cur ) {
2589: if ( crit_2( cur->i1,cur->i2 ) ) {
2590: remove = cur;
2591: if ( !prev ) head = cur = NEXT(cur);
2592: else cur = NEXT(prev) = NEXT(cur);
2593: FREENDP(remove);
2594: } else {
2595: prev = cur; cur = NEXT(cur);
2596: }
2597: }
2598: }
2599: if ( !d )
2600: return head;
2601: else {
2602: nd = d;
2603: while ( NEXT(nd) ) nd = NEXT(nd);
2604: NEXT(nd) = head;
2605: return d;
2606: }
2607: }
2608:
2609:
2610: ND_pairs nd_newpairs( NODE g, int t )
2611: {
2612: NODE h;
2613: UINT *dl;
2614: int ts,s,i,t0,min,max;
2615: ND_pairs r,r0;
2616:
2617: dl = DL(nd_psh[t]);
2618: ts = SG(nd_psh[t]) - TD(dl);
1.17 noro 2619: if ( nd_module && nd_intersect && (MPOS(dl) > nd_intersect) ) return 0;
1.1 noro 2620: for ( r0 = 0, h = g; h; h = NEXT(h) ) {
2621: if ( nd_module && (MPOS(DL(nd_psh[(long)BDY(h)])) != MPOS(dl)) )
2622: continue;
2623: if ( nd_gbblock ) {
2624: t0 = (long)BDY(h);
2625: for ( i = 0; nd_gbblock[i] >= 0; i += 2 ) {
2626: min = nd_gbblock[i]; max = nd_gbblock[i+1];
2627: if ( t0 >= min && t0 <= max && t >= min && t <= max )
2628: break;
2629: }
2630: if ( nd_gbblock[i] >= 0 )
2631: continue;
2632: }
2633: NEXTND_pairs(r0,r);
2634: r->i1 = (long)BDY(h);
2635: r->i2 = t;
2636: ndl_lcm(DL(nd_psh[r->i1]),dl,r->lcm);
2637: s = SG(nd_psh[r->i1])-TD(DL(nd_psh[r->i1]));
2638: SG(r) = MAX(s,ts) + TD(LCM(r));
2639: /* experimental */
2640: if ( nd_sugarweight )
2641: r->sugar2 = ndl_weight2(r->lcm);
2642: }
2643: if ( r0 ) NEXT(r) = 0;
2644: return r0;
2645: }
2646:
2647: /* ipair = [i1,i2],[i1,i2],... */
2648: ND_pairs nd_ipairtospair(NODE ipair)
2649: {
2650: int s1,s2;
2651: NODE tn,t;
2652: ND_pairs r,r0;
2653:
2654: for ( r0 = 0, t = ipair; t; t = NEXT(t) ) {
2655: NEXTND_pairs(r0,r);
2656: tn = BDY((LIST)BDY(t));
1.6 noro 2657: r->i1 = ZTOS((Q)ARG0(tn));
2658: r->i2 = ZTOS((Q)ARG1(tn));
1.1 noro 2659: ndl_lcm(DL(nd_psh[r->i1]),DL(nd_psh[r->i2]),r->lcm);
2660: s1 = SG(nd_psh[r->i1])-TD(DL(nd_psh[r->i1]));
2661: s2 = SG(nd_psh[r->i2])-TD(DL(nd_psh[r->i2]));
2662: SG(r) = MAX(s1,s2) + TD(LCM(r));
2663: /* experimental */
2664: if ( nd_sugarweight )
2665: r->sugar2 = ndl_weight2(r->lcm);
2666: }
2667: if ( r0 ) NEXT(r) = 0;
2668: return r0;
2669: }
2670:
2671: /* kokokara */
2672:
2673: ND_pairs crit_B( ND_pairs d, int s )
2674: {
2675: ND_pairs cur,head,prev,remove;
2676: UINT *t,*tl,*lcm;
2677: int td,tdl;
2678:
2679: if ( !d ) return 0;
2680: t = DL(nd_psh[s]);
2681: prev = 0;
2682: head = cur = d;
2683: lcm = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
2684: while ( cur ) {
2685: tl = cur->lcm;
2686: if ( ndl_reducible(tl,t) ) {
2687: ndl_lcm(DL(nd_psh[cur->i1]),t,lcm);
2688: if ( !ndl_equal(lcm,tl) ) {
2689: ndl_lcm(DL(nd_psh[cur->i2]),t,lcm);
2690: if (!ndl_equal(lcm,tl)) {
2691: remove = cur;
2692: if ( !prev ) {
2693: head = cur = NEXT(cur);
2694: } else {
2695: cur = NEXT(prev) = NEXT(cur);
2696: }
2697: FREENDP(remove);
2698: } else {
2699: prev = cur; cur = NEXT(cur);
2700: }
2701: } else {
2702: prev = cur; cur = NEXT(cur);
2703: }
2704: } else {
2705: prev = cur; cur = NEXT(cur);
2706: }
2707: }
2708: return head;
2709: }
2710:
2711: ND_pairs crit_M( ND_pairs d1 )
2712: {
2713: ND_pairs e,d2,d3,dd,p;
2714: UINT *id,*jd;
2715:
2716: if ( !d1 ) return d1;
2717: for ( dd = 0, e = d1; e; e = d3 ) {
2718: if ( !(d2 = NEXT(e)) ) {
2719: NEXT(e) = dd;
2720: return e;
2721: }
2722: id = LCM(e);
2723: for ( d3 = 0; d2; d2 = p ) {
2724: p = NEXT(d2);
2725: jd = LCM(d2);
2726: if ( ndl_equal(jd,id) )
2727: ;
2728: else if ( TD(jd) > TD(id) )
2729: if ( ndl_reducible(jd,id) ) continue;
2730: else ;
2731: else if ( ndl_reducible(id,jd) ) goto delit;
2732: NEXT(d2) = d3;
2733: d3 = d2;
2734: }
2735: NEXT(e) = dd;
2736: dd = e;
2737: continue;
2738: /**/
2739: delit: NEXT(d2) = d3;
2740: d3 = d2;
2741: for ( ; p; p = d2 ) {
2742: d2 = NEXT(p);
2743: NEXT(p) = d3;
2744: d3 = p;
2745: }
2746: FREENDP(e);
2747: }
2748: return dd;
2749: }
2750:
2751: ND_pairs crit_F( ND_pairs d1 )
2752: {
2753: ND_pairs rest, head,remove;
2754: ND_pairs last, p, r, w;
2755: int s;
2756:
2757: if ( !d1 ) return d1;
2758: for ( head = last = 0, p = d1; NEXT(p); ) {
2759: r = w = equivalent_pairs(p,&rest);
2760: s = SG(r);
2761: w = NEXT(w);
2762: while ( w ) {
2763: if ( crit_2(w->i1,w->i2) ) {
2764: r = w;
2765: w = NEXT(w);
2766: while ( w ) {
2767: remove = w;
2768: w = NEXT(w);
2769: FREENDP(remove);
2770: }
2771: break;
2772: } else if ( SG(w) < s ) {
2773: FREENDP(r);
2774: r = w;
2775: s = SG(r);
2776: w = NEXT(w);
2777: } else {
2778: remove = w;
2779: w = NEXT(w);
2780: FREENDP(remove);
2781: }
2782: }
2783: if ( last ) NEXT(last) = r;
2784: else head = r;
2785: NEXT(last = r) = 0;
2786: p = rest;
2787: if ( !p ) return head;
2788: }
2789: if ( !last ) return p;
2790: NEXT(last) = p;
2791: return head;
2792: }
2793:
2794: int crit_2( int dp1, int dp2 )
2795: {
2796: return ndl_disjoint(DL(nd_psh[dp1]),DL(nd_psh[dp2]));
2797: }
2798:
2799: ND_pairs equivalent_pairs( ND_pairs d1, ND_pairs *prest )
2800: {
2801: ND_pairs w,p,r,s;
2802: UINT *d;
2803:
2804: w = d1;
2805: d = LCM(w);
2806: s = NEXT(w);
2807: NEXT(w) = 0;
2808: for ( r = 0; s; s = p ) {
2809: p = NEXT(s);
2810: if ( ndl_equal(d,LCM(s)) ) {
2811: NEXT(s) = w; w = s;
2812: } else {
2813: NEXT(s) = r; r = s;
2814: }
2815: }
2816: *prest = r;
2817: return w;
2818: }
2819:
2820: NODE update_base(NODE nd,int ndp)
2821: {
2822: UINT *dl, *dln;
2823: NODE last, p, head;
2824:
2825: dl = DL(nd_psh[ndp]);
2826: for ( head = last = 0, p = nd; p; ) {
2827: dln = DL(nd_psh[(long)BDY(p)]);
2828: if ( ndl_reducible( dln, dl ) ) {
2829: p = NEXT(p);
2830: if ( last ) NEXT(last) = p;
2831: } else {
2832: if ( !last ) head = p;
2833: p = NEXT(last = p);
2834: }
2835: }
2836: head = append_one(head,ndp);
2837: return head;
2838: }
2839:
2840: ND_pairs nd_minp( ND_pairs d, ND_pairs *prest )
2841: {
2842: ND_pairs m,ml,p,l;
2843: UINT *lcm;
2844: int s,td,len,tlen,c,c1;
2845:
2846: if ( !(p = NEXT(m = d)) ) {
2847: *prest = p;
2848: NEXT(m) = 0;
2849: return m;
2850: }
2851: if ( !NoSugar ) {
2852: if ( nd_sugarweight ) {
2853: s = m->sugar2;
2854: for ( ml = 0, l = m; p; p = NEXT(l = p) )
2855: if ( (p->sugar2 < s)
2856: || ((p->sugar2 == s) && (DL_COMPARE(LCM(p),LCM(m)) < 0)) ) {
2857: ml = l; m = p; s = m->sugar2;
2858: }
2859: } else {
2860: s = SG(m);
2861: for ( ml = 0, l = m; p; p = NEXT(l = p) )
2862: if ( (SG(p) < s)
2863: || ((SG(p) == s) && (DL_COMPARE(LCM(p),LCM(m)) < 0)) ) {
2864: ml = l; m = p; s = SG(m);
2865: }
2866: }
2867: } else {
2868: for ( ml = 0, l = m; p; p = NEXT(l = p) )
2869: if ( DL_COMPARE(LCM(p),LCM(m)) < 0 ) {
2870: ml = l; m = p; s = SG(m);
2871: }
2872: }
2873: if ( !ml ) *prest = NEXT(m);
2874: else {
2875: NEXT(ml) = NEXT(m);
2876: *prest = d;
2877: }
2878: NEXT(m) = 0;
2879: return m;
2880: }
2881:
2882: ND_pairs nd_minsugarp( ND_pairs d, ND_pairs *prest )
2883: {
2884: int msugar,i;
2885: ND_pairs t,dm0,dm,dr0,dr;
2886:
2887: if ( nd_sugarweight ) {
2888: for ( msugar = d->sugar2, t = NEXT(d); t; t = NEXT(t) )
2889: if ( t->sugar2 < msugar ) msugar = t->sugar2;
2890: dm0 = 0; dr0 = 0;
2891: for ( i = 0, t = d; t; t = NEXT(t) )
2892: if ( i < nd_f4_nsp && t->sugar2 == msugar ) {
2893: if ( dm0 ) NEXT(dm) = t;
2894: else dm0 = t;
2895: dm = t;
2896: i++;
2897: } else {
2898: if ( dr0 ) NEXT(dr) = t;
2899: else dr0 = t;
2900: dr = t;
2901: }
2902: } else {
2903: for ( msugar = SG(d), t = NEXT(d); t; t = NEXT(t) )
2904: if ( SG(t) < msugar ) msugar = SG(t);
2905: dm0 = 0; dr0 = 0;
2906: for ( i = 0, t = d; t; t = NEXT(t) )
2907: if ( i < nd_f4_nsp && SG(t) == msugar ) {
2908: if ( dm0 ) NEXT(dm) = t;
2909: else dm0 = t;
2910: dm = t;
2911: i++;
2912: } else {
2913: if ( dr0 ) NEXT(dr) = t;
2914: else dr0 = t;
2915: dr = t;
2916: }
2917: }
2918: NEXT(dm) = 0;
2919: if ( dr0 ) NEXT(dr) = 0;
2920: *prest = dr0;
2921: return dm0;
2922: }
2923:
2924: int nd_tdeg(NDV c)
2925: {
2926: int wmax = 0;
2927: int i,len;
2928: NMV a;
2929:
2930: len = LEN(c);
2931: for ( a = BDY(c), i = 0; i < len; i++, NMV_ADV(a) )
2932: wmax = MAX(TD(DL(a)),wmax);
2933: return wmax;
2934: }
2935:
2936: int ndv_newps(int m,NDV a,NDV aq,int f4)
2937: {
2938: int len;
2939: RHist r;
2940: NDV b;
2941: NODE tn;
2942: LIST l;
2943: Z iq;
2944:
2945: if ( nd_psn == nd_pslen ) {
2946: nd_pslen *= 2;
2947: nd_ps = (NDV *)REALLOC((char *)nd_ps,nd_pslen*sizeof(NDV));
2948: nd_ps_trace = (NDV *)REALLOC((char *)nd_ps_trace,nd_pslen*sizeof(NDV));
2949: nd_psh = (RHist *)REALLOC((char *)nd_psh,nd_pslen*sizeof(RHist));
2950: nd_bound = (UINT **)
2951: REALLOC((char *)nd_bound,nd_pslen*sizeof(UINT *));
2952: nd_ps_sym = (NDV *)REALLOC((char *)nd_ps_sym,nd_pslen*sizeof(NDV));
2953: nd_ps_trace_sym = (NDV *)REALLOC((char *)nd_ps_trace_sym,nd_pslen*sizeof(NDV));
2954: }
2955: NEWRHist(r); nd_psh[nd_psn] = r;
2956: nd_ps[nd_psn] = a;
2957: if ( aq ) {
2958: nd_ps_trace[nd_psn] = aq;
2959: if ( !m ) {
2960: register_hcf(aq);
2961: } else if ( m == -2 ) {
2962: /* do nothing */
2963: } else
2964: error("ndv_newps : invalud modulus");
2965: nd_bound[nd_psn] = ndv_compute_bound(aq);
2966: #if 1
2967: SG(r) = SG(aq);
2968: #else
2969: SG(r) = nd_tdeg(aq);
2970: #endif
2971: ndl_copy(HDL(aq),DL(r));
2972: } else {
2973: if ( !m ) register_hcf(a);
2974: nd_bound[nd_psn] = ndv_compute_bound(a);
2975: #if 1
2976: SG(r) = SG(a);
2977: #else
2978: SG(r) = nd_tdeg(a);
2979: #endif
2980: ndl_copy(HDL(a),DL(r));
2981: }
2982: if ( nd_demand ) {
2983: if ( aq ) {
2984: ndv_save(nd_ps_trace[nd_psn],nd_psn);
2985: nd_ps_sym[nd_psn] = ndv_symbolic(m,nd_ps_trace[nd_psn]);
2986: nd_ps_trace_sym[nd_psn] = ndv_symbolic(m,nd_ps_trace[nd_psn]);
2987: nd_ps_trace[nd_psn] = 0;
2988: } else {
2989: ndv_save(nd_ps[nd_psn],nd_psn);
2990: nd_ps_sym[nd_psn] = ndv_symbolic(m,nd_ps[nd_psn]);
2991: nd_ps[nd_psn] = 0;
2992: }
2993: }
2994: if ( nd_gentrace ) {
2995: /* reverse the tracelist and append it to alltracelist */
2996: nd_tracelist = reverse_node(nd_tracelist); MKLIST(l,nd_tracelist);
1.6 noro 2997: STOZ(nd_psn,iq); tn = mknode(2,iq,l); MKLIST(l,tn);
1.1 noro 2998: MKNODE(tn,l,nd_alltracelist); nd_alltracelist = tn; nd_tracelist = 0;
2999: }
3000: return nd_psn++;
3001: }
3002:
3003: /* nd_tracelist = [[0,index,div],...,[nd_psn-1,index,div]] */
3004: /* return 1 if success, 0 if failure (HC(a mod p)) */
3005:
3006: int ndv_setup(int mod,int trace,NODE f,int dont_sort,int dont_removecont)
3007: {
1.6 noro 3008: int i,j,td,len,max;
3009: NODE s,s0,f0,tn;
3010: UINT *d;
3011: RHist r;
3012: NDVI w;
3013: NDV a,am;
3014: union oNDC hc;
3015: NODE node;
3016: P hcp;
3017: Z iq,jq;
3018: LIST l;
3019:
3020: nd_found = 0; nd_notfirst = 0; nd_create = 0;
3021: /* initialize the tracelist */
3022: nd_tracelist = 0;
3023:
3024: for ( nd_psn = 0, s = f; s; s = NEXT(s) ) if ( BDY(s) ) nd_psn++;
3025: w = (NDVI)MALLOC(nd_psn*sizeof(struct oNDVI));
3026: for ( i = j = 0, s = f; s; s = NEXT(s), j++ )
3027: if ( BDY(s) ) { w[i].p = BDY(s); w[i].i = j; i++; }
3028: if ( !dont_sort ) {
3029: /* XXX heuristic */
3030: if ( !nd_ord->id && (nd_ord->ord.simple<2) )
3031: qsort(w,nd_psn,sizeof(struct oNDVI),
3032: (int (*)(const void *,const void *))ndvi_compare_rev);
3033: else
3034: qsort(w,nd_psn,sizeof(struct oNDVI),
3035: (int (*)(const void *,const void *))ndvi_compare);
3036: }
3037: nd_pslen = 2*nd_psn;
3038: nd_ps = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3039: nd_ps_trace = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3040: nd_ps_sym = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3041: nd_ps_trace_sym = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3042: nd_psh = (RHist *)MALLOC(nd_pslen*sizeof(RHist));
3043: nd_bound = (UINT **)MALLOC(nd_pslen*sizeof(UINT *));
3044: nd_hcf = 0;
1.1 noro 3045:
1.6 noro 3046: if ( trace && nd_vc )
3047: makesubst(nd_vc,&nd_subst);
3048: else
3049: nd_subst = 0;
1.1 noro 3050:
1.6 noro 3051: if ( !nd_red )
3052: nd_red = (RHist *)MALLOC(REDTAB_LEN*sizeof(RHist));
3053: for ( i = 0; i < REDTAB_LEN; i++ ) nd_red[i] = 0;
3054: for ( i = 0; i < nd_psn; i++ ) {
3055: hc = HCU(w[i].p);
3056: if ( trace ) {
3057: if ( mod == -2 ) {
3058: /* over a large finite field */
3059: /* trace = small modulus */
3060: a = nd_ps_trace[i] = ndv_dup(-2,w[i].p);
3061: ndv_mod(-2,a);
3062: if ( !dont_removecont) ndv_removecont(-2,a);
3063: am = nd_ps[i] = ndv_dup(trace,w[i].p);
3064: ndv_mod(trace,am);
3065: if ( DL_COMPARE(HDL(am),HDL(a)) )
3066: return 0;
3067: ndv_removecont(trace,am);
3068: } else {
3069: a = nd_ps_trace[i] = ndv_dup(0,w[i].p);
3070: if ( !dont_removecont) ndv_removecont(0,a);
3071: register_hcf(a);
3072: am = nd_ps[i] = ndv_dup(mod,a);
3073: ndv_mod(mod,am);
3074: if ( DL_COMPARE(HDL(am),HDL(a)) )
3075: return 0;
3076: ndv_removecont(mod,am);
3077: }
3078: } else {
3079: a = nd_ps[i] = ndv_dup(mod,w[i].p);
3080: if ( mod || !dont_removecont ) ndv_removecont(mod,a);
3081: if ( !mod ) register_hcf(a);
1.1 noro 3082: }
1.6 noro 3083: if ( nd_gentrace ) {
3084: STOZ(i,iq); STOZ(w[i].i,jq); node = mknode(3,iq,jq,ONE);
3085: /* exact division */
1.1 noro 3086: if ( !dont_removecont )
1.6 noro 3087: ARG2(node) = (pointer)ndc_div(trace?0:mod,hc,HCU(a));
3088: MKLIST(l,node); NEXTNODE(nd_tracelist,tn); BDY(tn) = l;
3089: }
3090: NEWRHist(r); SG(r) = HTD(a); ndl_copy(HDL(a),DL(r));
3091: nd_bound[i] = ndv_compute_bound(a);
3092: nd_psh[i] = r;
3093: if ( nd_demand ) {
3094: if ( trace ) {
3095: ndv_save(nd_ps_trace[i],i);
3096: nd_ps_sym[i] = ndv_symbolic(mod,nd_ps_trace[i]);
3097: nd_ps_trace_sym[i] = ndv_symbolic(mod,nd_ps_trace[i]);
3098: nd_ps_trace[i] = 0;
3099: } else {
3100: ndv_save(nd_ps[i],i);
3101: nd_ps_sym[i] = ndv_symbolic(mod,nd_ps[i]);
3102: nd_ps[i] = 0;
3103: }
1.1 noro 3104: }
1.6 noro 3105: }
3106: if ( nd_gentrace && nd_tracelist ) NEXT(tn) = 0;
3107: return 1;
1.1 noro 3108: }
3109:
3110: struct order_spec *append_block(struct order_spec *spec,
3111: int nv,int nalg,int ord);
3112:
3113: extern VECT current_dl_weight_vector_obj;
3114: static VECT prev_weight_vector_obj;
3115:
3116: void preprocess_algcoef(VL vv,VL av,struct order_spec *ord,LIST f,
3117: struct order_spec **ord1p,LIST *f1p,NODE *alistp)
3118: {
3119: NODE alist,t,s,r0,r,arg;
3120: VL tv;
3121: P poly;
3122: DP d;
3123: Alg alpha,dp;
3124: DAlg inv,da,hc;
3125: MP m;
3126: int i,nvar,nalg,n;
3127: NumberField nf;
3128: LIST f1,f2;
3129: struct order_spec *current_spec;
3130: VECT obj,obj0;
3131: VECT tmp;
3132:
3133: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++);
3134: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++);
3135:
3136: for ( alist = 0, tv = av; tv; tv = NEXT(tv) ) {
3137: NEXTNODE(alist,t); MKV(tv->v,poly);
3138: MKAlg(poly,alpha); BDY(t) = (pointer)alpha;
3139: tv->v = tv->v->priv;
3140: }
3141: NEXT(t) = 0;
3142:
3143: /* simplification, making polynomials monic */
3144: setfield_dalg(alist);
3145: obj_algtodalg((Obj)f,(Obj *)&f1);
3146: for ( t = BDY(f); t; t = NEXT(t) ) {
3147: initd(ord); ptod(vv,vv,(P)BDY(t),&d);
3148: hc = (DAlg)BDY(d)->c;
3149: if ( NID(hc) == N_DA ) {
3150: invdalg(hc,&inv);
3151: for ( m = BDY(d); m; m = NEXT(m) ) {
3152: muldalg(inv,(DAlg)m->c,&da); m->c = (Obj)da;
3153: }
3154: }
3155: initd(ord); dtop(vv,vv,d,(Obj *)&poly); BDY(f) = (pointer)poly;
3156: }
3157: obj_dalgtoalg((Obj)f1,(Obj *)&f);
3158:
3159: /* append alg vars to the var list */
3160: for ( tv = vv; NEXT(tv); tv = NEXT(tv) );
3161: NEXT(tv) = av;
3162:
3163: /* append a block to ord */
3164: *ord1p = append_block(ord,nvar,nalg,2);
3165:
3166: /* create generator list */
3167: nf = get_numberfield();
3168: for ( i = nalg-1, t = BDY(f); i >= 0; i-- ) {
3169: MKAlg(nf->defpoly[i],dp);
3170: MKNODE(s,dp,t); t = s;
3171: }
3172: MKLIST(f1,t);
3173: *alistp = alist;
3174: algobjtorat((Obj)f1,(Obj *)f1p);
3175:
3176: /* creating a new weight vector */
3177: prev_weight_vector_obj = obj0 = current_dl_weight_vector_obj;
3178: n = nvar+nalg+1;
3179: MKVECT(obj,n);
3180: if ( obj0 && obj0->len == nvar )
3181: for ( i = 0; i < nvar; i++ ) BDY(obj)[i] = BDY(obj0)[i];
3182: else
3183: for ( i = 0; i < nvar; i++ ) BDY(obj)[i] = (pointer)ONE;
3184: for ( i = 0; i < nalg; i++ ) BDY(obj)[i+nvar] = 0;
3185: BDY(obj)[n-1] = (pointer)ONE;
3186: arg = mknode(1,obj);
3187: Pdp_set_weight(arg,&tmp);
3188: }
3189:
3190: NODE postprocess_algcoef(VL av,NODE alist,NODE r)
3191: {
3192: NODE s,t,u0,u;
3193: P p;
3194: VL tv;
3195: Obj obj;
3196: VECT tmp;
3197: NODE arg;
3198:
3199: u0 = 0;
3200: for ( t = r; t; t = NEXT(t) ) {
3201: p = (P)BDY(t);
3202: for ( tv = av, s = alist; tv; tv = NEXT(tv), s = NEXT(s) ) {
3203: substr(CO,0,(Obj)p,tv->v,(Obj)BDY(s),&obj); p = (P)obj;
3204: }
3205: if ( OID(p) == O_P || (OID(p) == O_N && NID((Num)p) != N_A) ) {
3206: NEXTNODE(u0,u);
3207: BDY(u) = (pointer)p;
3208: }
3209: }
3210: arg = mknode(1,prev_weight_vector_obj);
3211: Pdp_set_weight(arg,&tmp);
3212:
3213: return u0;
3214: }
3215:
3216: void nd_gr(LIST f,LIST v,int m,int homo,int retdp,int f4,struct order_spec *ord,LIST *rp)
3217: {
3218: VL tv,fv,vv,vc,av;
3219: NODE fd,fd0,r,r0,t,x,s,xx,alist;
3220: int e,max,nvar,i;
3221: NDV b;
3222: int ishomo,nalg,mrank,trank,wmax,len;
3223: NMV a;
3224: Alg alpha,dp;
3225: P p,zp;
3226: Q dmy;
3227: LIST f1,f2,zpl;
3228: Obj obj;
3229: NumberField nf;
3230: struct order_spec *ord1;
3231: NODE tr,tl1,tl2,tl3,tl4,nzlist;
3232: LIST l1,l2,l3,l4,l5;
3233: int j;
3234: Z jq,bpe,last_nonzero;
3235: int *perm;
3236: EPOS oepos;
3237: int obpe,oadv,ompos,cbpe;
1.15 noro 3238: VECT hvect;
1.1 noro 3239:
3240: nd_module = 0;
3241: if ( !m && Demand ) nd_demand = 1;
3242: else nd_demand = 0;
3243: parse_nd_option(current_option);
3244:
3245: if ( DP_Multiple )
3246: nd_scale = ((double)DP_Multiple)/(double)(Denominator?Denominator:1);
3247: #if 0
3248: ndv_alloc = 0;
3249: #endif
3250: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
3251: if ( m && nd_vc )
3252: error("nd_{gr,f4} : computation over Fp(X) is unsupported. Use dp_gr_mod_main().");
3253: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
3254: switch ( ord->id ) {
3255: case 1:
3256: if ( ord->nv != nvar )
3257: error("nd_{gr,f4} : invalid order specification");
3258: break;
3259: default:
3260: break;
3261: }
3262: nd_nalg = 0;
3263: av = 0;
3264: if ( !m ) {
3265: get_algtree((Obj)f,&av);
3266: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++ );
3267: nd_ntrans = nvar;
3268: nd_nalg = nalg;
3269: /* #i -> t#i */
3270: if ( nalg ) {
3271: preprocess_algcoef(vv,av,ord,f,&ord1,&f1,&alist);
3272: ord = ord1;
3273: f = f1;
3274: }
3275: nvar += nalg;
3276: }
3277: nd_init_ord(ord);
3278: mrank = 0;
3279: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
3280: for ( tv = vv; tv; tv = NEXT(tv) ) {
3281: if ( nd_module ) {
1.16 noro 3282: if ( OID(BDY(t)) == O_DPM ) {
3283: e = dpm_getdeg((DPM)BDY(t),&trank);
3284: max = MAX(e,max);
3285: mrank = MAX(mrank,trank);
3286: } else {
3287: s = BDY((LIST)BDY(t));
3288: trank = length(s);
3289: mrank = MAX(mrank,trank);
3290: for ( ; s; s = NEXT(s) ) {
3291: e = getdeg(tv->v,(P)BDY(s));
3292: max = MAX(e,max);
3293: }
1.1 noro 3294: }
3295: } else {
3296: e = getdeg(tv->v,(P)BDY(t));
3297: max = MAX(e,max);
3298: }
3299: }
3300: nd_setup_parameters(nvar,nd_nzlist?0:max);
3301: obpe = nd_bpe; oadv = nmv_adv; oepos = nd_epos; ompos = nd_mpos;
3302: ishomo = 1;
3303: for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
3304: if ( nd_module ) {
1.16 noro 3305: if ( OID(BDY(t)) == O_DPM ) {
3306: Z cont;
3307: DPM zdpm;
3308:
3309: if ( !m && !nd_gentrace ) dpm_ptozp((DPM)BDY(t),&cont,&zdpm);
3310: else zdpm = (DPM)BDY(t);
3311: b = (pointer)dpmtondv(m,zdpm);
3312: } else {
3313: if ( !m && !nd_gentrace ) pltozpl((LIST)BDY(t),&dmy,&zpl);
3314: else zpl = (LIST)BDY(t);
1.1 noro 3315: b = (pointer)pltondv(CO,vv,zpl);
1.16 noro 3316: }
1.1 noro 3317: } else {
3318: if ( !m && !nd_gentrace ) ptozp((P)BDY(t),1,&dmy,&zp);
3319: else zp = (P)BDY(t);
3320: b = (pointer)ptondv(CO,vv,zp);
3321: }
3322: if ( ishomo )
3323: ishomo = ishomo && ndv_ishomo(b);
3324: if ( m ) ndv_mod(m,b);
3325: if ( b ) { NEXTNODE(fd0,fd); BDY(fd) = (pointer)b; }
3326: }
3327: if ( fd0 ) NEXT(fd) = 0;
3328:
3329: if ( !ishomo && homo ) {
3330: for ( t = fd0, wmax = max; t; t = NEXT(t) ) {
3331: b = (NDV)BDY(t); len = LEN(b);
3332: for ( a = BDY(b), i = 0; i < len; i++, NMV_ADV(a) )
3333: wmax = MAX(TD(DL(a)),wmax);
3334: }
3335: homogenize_order(ord,nvar,&ord1);
3336: nd_init_ord(ord1);
3337: nd_setup_parameters(nvar+1,nd_nzlist?0:wmax);
3338: for ( t = fd0; t; t = NEXT(t) )
3339: ndv_homogenize((NDV)BDY(t),obpe,oadv,oepos,ompos);
3340: }
3341:
3342: ndv_setup(m,0,fd0,(nd_gbblock||nd_splist||nd_check_splist)?1:0,0);
3343: if ( nd_gentrace ) {
3344: MKLIST(l1,nd_tracelist); MKNODE(nd_alltracelist,l1,0);
3345: }
3346: if ( nd_splist ) {
3347: *rp = compute_splist();
3348: return;
3349: }
3350: if ( nd_check_splist ) {
3351: if ( f4 ) {
3352: if ( check_splist_f4(m,nd_check_splist) ) *rp = (LIST)ONE;
3353: else *rp = 0;
3354: } else {
3355: if ( check_splist(m,nd_check_splist) ) *rp = (LIST)ONE;
3356: else *rp = 0;
3357: }
3358: return;
3359: }
3360: x = f4?nd_f4(m,0,&perm):nd_gb(m,ishomo || homo,0,0,&perm);
3361: if ( !x ) {
3362: *rp = 0; return;
3363: }
1.15 noro 3364: if ( nd_gentrace ) {
3365: MKVECT(hvect,nd_psn);
3366: for ( i = 0; i < nd_psn; i++ )
3367: ndltodp(nd_psh[i]->dl,(DP *)&BDY(hvect)[i]);
3368: }
1.1 noro 3369: if ( !ishomo && homo ) {
3370: /* dehomogenization */
3371: for ( t = x; t; t = NEXT(t) ) ndv_dehomogenize((NDV)BDY(t),ord);
3372: nd_init_ord(ord);
3373: nd_setup_parameters(nvar,0);
3374: }
3375: nd_demand = 0;
3376: if ( nd_module && nd_intersect ) {
3377: for ( j = nd_psn-1, x = 0; j >= 0; j-- )
1.17 noro 3378: if ( MPOS(DL(nd_psh[j])) > nd_intersect ) {
1.1 noro 3379: MKNODE(xx,(pointer)((unsigned long)j),x); x = xx;
3380: }
3381: conv_ilist(nd_demand,0,x,0);
3382: goto FINAL;
3383: }
3384: if ( nd_gentrace && f4 ) { nzlist = nd_alltracelist; }
3385: x = ndv_reducebase(x,perm);
3386: if ( nd_gentrace && !f4 ) { tl1 = nd_alltracelist; nd_alltracelist = 0; }
3387: x = ndv_reduceall(m,x);
3388: cbpe = nd_bpe;
3389: if ( nd_gentrace && !f4 ) {
3390: tl2 = nd_alltracelist; nd_alltracelist = 0;
3391: ndv_check_membership(m,fd0,obpe,oadv,oepos,x);
3392: tl3 = nd_alltracelist; nd_alltracelist = 0;
3393: if ( nd_gensyz ) {
3394: nd_gb(m,0,1,1,0);
3395: tl4 = nd_alltracelist; nd_alltracelist = 0;
3396: } else tl4 = 0;
3397: }
3398: nd_bpe = cbpe;
3399: nd_setup_parameters(nd_nvar,0);
3400: FINAL:
3401: for ( r0 = 0, t = x; t; t = NEXT(t) ) {
1.16 noro 3402: NEXTNODE(r0,r);
3403: if ( nd_module ) {
3404: if ( retdp ) BDY(r) = ndvtodpm(m,BDY(t));
3405: else BDY(r) = ndvtopl(m,CO,vv,BDY(t),mrank);
3406: } else if ( retdp ) BDY(r) = ndvtodp(m,BDY(t));
3407: else BDY(r) = ndvtop(m,CO,vv,BDY(t));
1.1 noro 3408: }
3409: if ( r0 ) NEXT(r) = 0;
3410: if ( !m && nd_nalg )
3411: r0 = postprocess_algcoef(av,alist,r0);
3412: MKLIST(*rp,r0);
3413: if ( nd_gentrace ) {
3414: if ( f4 ) {
1.6 noro 3415: STOZ(16,bpe);
3416: STOZ(nd_last_nonzero,last_nonzero);
1.15 noro 3417: tr = mknode(6,*rp,(!ishomo&&homo)?ONE:0,BDY(nzlist),bpe,last_nonzero,hvect); MKLIST(*rp,tr);
1.1 noro 3418: } else {
3419: tl1 = reverse_node(tl1); tl2 = reverse_node(tl2);
3420: tl3 = reverse_node(tl3);
3421: /* tl2 = [[i,[[*,j,*,*],...]],...] */
3422: for ( t = tl2; t; t = NEXT(t) ) {
3423: /* s = [i,[*,j,*,*],...] */
3424: s = BDY((LIST)BDY(t));
1.6 noro 3425: j = perm[ZTOS((Q)ARG0(s))]; STOZ(j,jq); ARG0(s) = (pointer)jq;
1.1 noro 3426: for ( s = BDY((LIST)ARG1(s)); s; s = NEXT(s) ) {
1.6 noro 3427: j = perm[ZTOS((Q)ARG1(BDY((LIST)BDY(s))))]; STOZ(j,jq);
1.1 noro 3428: ARG1(BDY((LIST)BDY(s))) = (pointer)jq;
3429: }
3430: }
3431: for ( j = length(x)-1, t = 0; j >= 0; j-- ) {
1.6 noro 3432: STOZ(perm[j],jq); MKNODE(s,jq,t); t = s;
1.1 noro 3433: }
3434: MKLIST(l1,tl1); MKLIST(l2,tl2); MKLIST(l3,t); MKLIST(l4,tl3);
3435: MKLIST(l5,tl4);
1.6 noro 3436: STOZ(nd_bpe,bpe);
1.15 noro 3437: tr = mknode(9,*rp,(!ishomo&&homo)?ONE:0,l1,l2,l3,l4,l5,bpe,hvect); MKLIST(*rp,tr);
1.1 noro 3438: }
3439: }
3440: #if 0
3441: fprintf(asir_out,"ndv_alloc=%d\n",ndv_alloc);
3442: #endif
3443: }
3444:
3445: void nd_gr_postproc(LIST f,LIST v,int m,struct order_spec *ord,int do_check,LIST *rp)
3446: {
3447: VL tv,fv,vv,vc,av;
3448: NODE fd,fd0,r,r0,t,x,s,xx,alist;
3449: int e,max,nvar,i;
3450: NDV b;
3451: int ishomo,nalg;
3452: Alg alpha,dp;
3453: P p,zp;
3454: Q dmy;
3455: LIST f1,f2;
3456: Obj obj;
3457: NumberField nf;
3458: struct order_spec *ord1;
3459: int *perm;
3460:
3461: parse_nd_option(current_option);
3462: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
3463: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
3464: switch ( ord->id ) {
3465: case 1:
3466: if ( ord->nv != nvar )
3467: error("nd_check : invalid order specification");
3468: break;
3469: default:
3470: break;
3471: }
3472: nd_nalg = 0;
3473: av = 0;
3474: if ( !m ) {
3475: get_algtree((Obj)f,&av);
3476: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++ );
3477: nd_ntrans = nvar;
3478: nd_nalg = nalg;
3479: /* #i -> t#i */
3480: if ( nalg ) {
3481: preprocess_algcoef(vv,av,ord,f,&ord1,&f1,&alist);
3482: ord = ord1;
3483: f = f1;
3484: }
3485: nvar += nalg;
3486: }
3487: nd_init_ord(ord);
3488: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
3489: for ( tv = vv; tv; tv = NEXT(tv) ) {
3490: e = getdeg(tv->v,(P)BDY(t));
3491: max = MAX(e,max);
3492: }
3493: nd_setup_parameters(nvar,max);
3494: ishomo = 1;
3495: for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
3496: ptozp((P)BDY(t),1,&dmy,&zp);
3497: b = (pointer)ptondv(CO,vv,zp);
3498: if ( ishomo )
3499: ishomo = ishomo && ndv_ishomo(b);
3500: if ( m ) ndv_mod(m,b);
3501: if ( b ) { NEXTNODE(fd0,fd); BDY(fd) = (pointer)b; }
3502: }
3503: if ( fd0 ) NEXT(fd) = 0;
3504: ndv_setup(m,0,fd0,0,1);
3505: for ( x = 0, i = 0; i < nd_psn; i++ )
3506: x = update_base(x,i);
3507: if ( do_check ) {
3508: x = nd_gb(m,ishomo,1,0,&perm);
3509: if ( !x ) {
3510: *rp = 0;
3511: return;
3512: }
3513: } else {
3514: #if 0
3515: /* bug ? */
3516: for ( t = x; t; t = NEXT(t) )
3517: BDY(t) = (pointer)nd_ps[(long)BDY(t)];
3518: #else
3519: conv_ilist(0,0,x,&perm);
3520: #endif
3521: }
3522: x = ndv_reducebase(x,perm);
3523: x = ndv_reduceall(m,x);
3524: for ( r0 = 0, t = x; t; t = NEXT(t) ) {
3525: NEXTNODE(r0,r);
3526: BDY(r) = ndvtop(m,CO,vv,BDY(t));
3527: }
3528: if ( r0 ) NEXT(r) = 0;
3529: if ( !m && nd_nalg )
3530: r0 = postprocess_algcoef(av,alist,r0);
3531: MKLIST(*rp,r0);
3532: }
3533:
3534: NDV recompute_trace(NODE trace,NDV *p,int m);
3535: void nd_gr_recompute_trace(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,LIST *rp);
3536:
3537: NDV recompute_trace(NODE ti,NDV *p,int mod)
3538: {
3539: int c,c1,c2,i;
3540: NM mul,m,tail;
3541: ND d,r,rm;
3542: NODE sj;
3543: NDV red;
3544: Obj mj;
3545:
3546: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
3547: CM(mul) = 1;
3548: tail = 0;
3549: for ( i = 0, d = r = 0; ti; ti = NEXT(ti), i++ ) {
3550: sj = BDY((LIST)BDY(ti));
3551: if ( ARG0(sj) ) {
1.6 noro 3552: red = p[ZTOS((Q)ARG1(sj))];
1.1 noro 3553: mj = (Obj)ARG2(sj);
3554: if ( OID(mj) != O_DP ) ndl_zero(DL(mul));
3555: else dltondl(nd_nvar,BDY((DP)mj)->dl,DL(mul));
3556: rm = ndv_mul_nm(mod,mul,red);
3557: if ( !r ) r = rm;
3558: else {
3559: for ( m = BDY(r); m && !ndl_equal(m->dl,BDY(rm)->dl); m = NEXT(m), LEN(r)-- ) {
3560: if ( d ) {
3561: NEXT(tail) = m; tail = m; LEN(d)++;
3562: } else {
3563: MKND(nd_nvar,m,1,d); tail = BDY(d);
3564: }
3565: }
3566: if ( !m ) return 0; /* failure */
3567: else {
3568: BDY(r) = m;
3569: if ( mod > 0 || mod == -1 ) {
3570: c1 = invm(HCM(rm),mod); c2 = mod-HCM(r);
3571: DMAR(c1,c2,0,mod,c);
3572: nd_mul_c(mod,rm,c);
3573: } else {
3574: Z t,u;
3575:
3576: chsgnlf(HCZ(r),&t);
3577: divlf(t,HCZ(rm),&u);
3578: nd_mul_c_lf(rm,u);
3579: }
3580: r = nd_add(mod,r,rm);
3581: }
3582: }
3583: }
3584: }
3585: if ( tail ) NEXT(tail) = 0;
3586: d = nd_add(mod,d,r);
3587: nd_mul_c(mod,d,invm(HCM(d),mod));
3588: return ndtondv(mod,d);
3589: }
3590:
3591: void nd_gr_recompute_trace(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,LIST *rp)
3592: {
3593: VL tv,fv,vv,vc,av;
3594: NODE fd,fd0,r,r0,t,x,s,xx,alist;
3595: int e,max,nvar,i;
3596: NDV b;
3597: int ishomo,nalg;
3598: Alg alpha,dp;
3599: P p,zp;
3600: Q dmy;
3601: LIST f1,f2;
3602: Obj obj;
3603: NumberField nf;
3604: struct order_spec *ord1;
3605: NODE permtrace,intred,ind,perm,trace,ti;
3606: int len,n,j;
3607: NDV *db,*pb;
3608:
3609: parse_nd_option(current_option);
3610: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
3611: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
3612: switch ( ord->id ) {
3613: case 1:
3614: if ( ord->nv != nvar )
3615: error("nd_check : invalid order specification");
3616: break;
3617: default:
3618: break;
3619: }
3620: nd_init_ord(ord);
1.6 noro 3621: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 3622: nd_setup_parameters(nvar,0);
3623:
3624: len = length(BDY(f));
3625: db = (NDV *)MALLOC(len*sizeof(NDV *));
3626: for ( i = 0, t = BDY(f); t; i++, t = NEXT(t) ) {
3627: ptozp((P)BDY(t),1,&dmy,&zp);
3628: b = ptondv(CO,vv,zp);
3629: ndv_mod(m,b);
3630: ndv_mul_c(m,b,invm(HCM(b),m));
3631: db[i] = b;
3632: }
3633:
3634: permtrace = BDY((LIST)ARG2(BDY(tlist)));
3635: intred = BDY((LIST)ARG3(BDY(tlist)));
3636: ind = BDY((LIST)ARG4(BDY(tlist)));
3637: perm = BDY((LIST)ARG0(permtrace));
3638: trace = NEXT(permtrace);
3639:
3640: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 3641: j = ZTOS((Q)ARG0(BDY((LIST)BDY(t))));
1.1 noro 3642: if ( j > i ) i = j;
3643: }
3644: n = i+1;
3645: pb = (NDV *)MALLOC(n*sizeof(NDV *));
3646: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
3647: ti = BDY((LIST)BDY(t));
1.6 noro 3648: pb[ZTOS((Q)ARG0(ti))] = db[ZTOS((Q)ARG1(ti))];
1.1 noro 3649: }
3650: for ( t = trace; t; t = NEXT(t) ) {
3651: ti = BDY((LIST)BDY(t));
1.6 noro 3652: pb[ZTOS((Q)ARG0(ti))] = recompute_trace(BDY((LIST)ARG1(ti)),pb,m);
3653: if ( !pb[ZTOS((Q)ARG0(ti))] ) { *rp = 0; return; }
1.1 noro 3654: if ( DP_Print ) {
3655: fprintf(asir_out,"."); fflush(asir_out);
3656: }
3657: }
3658: for ( t = intred; t; t = NEXT(t) ) {
3659: ti = BDY((LIST)BDY(t));
1.6 noro 3660: pb[ZTOS((Q)ARG0(ti))] = recompute_trace(BDY((LIST)ARG1(ti)),pb,m);
3661: if ( !pb[ZTOS((Q)ARG0(ti))] ) { *rp = 0; return; }
1.1 noro 3662: if ( DP_Print ) {
3663: fprintf(asir_out,"*"); fflush(asir_out);
3664: }
3665: }
3666: for ( r0 = 0, t = ind; t; t = NEXT(t) ) {
3667: NEXTNODE(r0,r);
1.6 noro 3668: b = pb[ZTOS((Q)BDY(t))];
1.1 noro 3669: ndv_mul_c(m,b,invm(HCM(b),m));
3670: #if 0
1.6 noro 3671: BDY(r) = ndvtop(m,CO,vv,pb[ZTOS((Q)BDY(t))]);
1.1 noro 3672: #else
1.6 noro 3673: BDY(r) = ndvtodp(m,pb[ZTOS((Q)BDY(t))]);
1.1 noro 3674: #endif
3675: }
3676: if ( r0 ) NEXT(r) = 0;
3677: MKLIST(*rp,r0);
3678: if ( DP_Print ) fprintf(asir_out,"\n");
3679: }
3680:
1.16 noro 3681: void nd_gr_trace(LIST f,LIST v,int trace,int homo,int retdp,int f4,struct order_spec *ord,LIST *rp)
1.1 noro 3682: {
3683: VL tv,fv,vv,vc,av;
3684: NODE fd,fd0,in0,in,r,r0,t,s,cand,alist;
3685: int m,nocheck,nvar,mindex,e,max;
3686: NDV c;
3687: NMV a;
3688: P p,zp;
3689: Q dmy;
3690: EPOS oepos;
3691: int obpe,oadv,wmax,i,len,cbpe,ishomo,nalg,mrank,trank,ompos;
3692: Alg alpha,dp;
3693: P poly;
3694: LIST f1,f2,zpl;
3695: Obj obj;
3696: NumberField nf;
3697: struct order_spec *ord1;
3698: struct oEGT eg_check,eg0,eg1;
3699: NODE tr,tl1,tl2,tl3,tl4;
3700: LIST l1,l2,l3,l4,l5;
3701: int *perm;
3702: int j,ret;
3703: Z jq,bpe;
1.15 noro 3704: VECT hvect;
1.1 noro 3705:
3706: nd_module = 0;
3707: nd_lf = 0;
3708: parse_nd_option(current_option);
3709: if ( nd_lf ) {
3710: if ( f4 )
3711: nd_f4_lf_trace(f,v,trace,homo,ord,rp);
3712: else
3713: error("nd_gr_trace is not implemented yet over a large finite field");
3714: return;
3715: }
3716: if ( DP_Multiple )
3717: nd_scale = ((double)DP_Multiple)/(double)(Denominator?Denominator:1);
3718:
3719: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
3720: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
3721: switch ( ord->id ) {
3722: case 1:
3723: if ( ord->nv != nvar )
3724: error("nd_gr_trace : invalid order specification");
3725: break;
3726: default:
3727: break;
3728: }
3729:
3730: get_algtree((Obj)f,&av);
3731: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++ );
3732: nd_ntrans = nvar;
3733: nd_nalg = nalg;
3734: /* #i -> t#i */
3735: if ( nalg ) {
3736: preprocess_algcoef(vv,av,ord,f,&ord1,&f1,&alist);
3737: ord = ord1;
3738: f = f1;
3739: }
3740: nvar += nalg;
3741:
3742: nocheck = 0;
3743: mindex = 0;
3744:
3745: if ( Demand ) nd_demand = 1;
3746: else nd_demand = 0;
3747:
3748: /* setup modulus */
3749: if ( trace < 0 ) {
3750: trace = -trace;
3751: nocheck = 1;
3752: }
3753: m = trace > 1 ? trace : get_lprime(mindex);
3754: nd_init_ord(ord);
3755: mrank = 0;
3756: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
3757: for ( tv = vv; tv; tv = NEXT(tv) ) {
3758: if ( nd_module ) {
1.16 noro 3759: if ( OID(BDY(t)) == O_DPM ) {
3760: e = dpm_getdeg((DPM)BDY(t),&trank);
3761: max = MAX(e,max);
3762: mrank = MAX(mrank,trank);
3763: } else {
1.1 noro 3764: s = BDY((LIST)BDY(t));
3765: trank = length(s);
3766: mrank = MAX(mrank,trank);
3767: for ( ; s; s = NEXT(s) ) {
3768: e = getdeg(tv->v,(P)BDY(s));
3769: max = MAX(e,max);
3770: }
1.16 noro 3771: }
1.1 noro 3772: } else {
3773: e = getdeg(tv->v,(P)BDY(t));
3774: max = MAX(e,max);
3775: }
3776: }
3777: nd_setup_parameters(nvar,max);
3778: obpe = nd_bpe; oadv = nmv_adv; oepos = nd_epos; ompos = nd_mpos;
3779: ishomo = 1;
3780: for ( in0 = 0, fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
3781: if ( nd_module ) {
1.16 noro 3782: if ( OID(BDY(t)) == O_DPM ) {
3783: Z cont;
3784: DPM zdpm;
3785:
1.17 noro 3786: if ( !nd_gentrace ) dpm_ptozp((DPM)BDY(t),&cont,&zdpm);
1.16 noro 3787: else zdpm = (DPM)BDY(t);
3788: c = (pointer)dpmtondv(m,zdpm);
3789: } else {
3790: if ( !nd_gentrace ) pltozpl((LIST)BDY(t),&dmy,&zpl);
3791: else zpl = (LIST)BDY(t);
1.1 noro 3792: c = (pointer)pltondv(CO,vv,zpl);
1.16 noro 3793: }
1.1 noro 3794: } else {
1.16 noro 3795: if ( !nd_gentrace ) ptozp((P)BDY(t),1,&dmy,&zp);
3796: else zp = (P)BDY(t);
3797: c = (pointer)ptondv(CO,vv,zp);
1.1 noro 3798: }
3799: if ( ishomo )
3800: ishomo = ishomo && ndv_ishomo(c);
3801: if ( c ) {
3802: NEXTNODE(in0,in); BDY(in) = (pointer)c;
3803: NEXTNODE(fd0,fd); BDY(fd) = (pointer)ndv_dup(0,c);
3804: }
3805: }
3806: if ( in0 ) NEXT(in) = 0;
3807: if ( fd0 ) NEXT(fd) = 0;
3808: if ( !ishomo && homo ) {
3809: for ( t = in0, wmax = max; t; t = NEXT(t) ) {
3810: c = (NDV)BDY(t); len = LEN(c);
3811: for ( a = BDY(c), i = 0; i < len; i++, NMV_ADV(a) )
3812: wmax = MAX(TD(DL(a)),wmax);
3813: }
3814: homogenize_order(ord,nvar,&ord1);
3815: nd_init_ord(ord1);
3816: nd_setup_parameters(nvar+1,wmax);
3817: for ( t = fd0; t; t = NEXT(t) )
3818: ndv_homogenize((NDV)BDY(t),obpe,oadv,oepos,ompos);
3819: }
3820: if ( MaxDeg > 0 ) nocheck = 1;
3821: while ( 1 ) {
3822: tl1 = tl2 = tl3 = tl4 = 0;
3823: if ( Demand )
3824: nd_demand = 1;
3825: ret = ndv_setup(m,1,fd0,nd_gbblock?1:0,0);
3826: if ( nd_gentrace ) {
3827: MKLIST(l1,nd_tracelist); MKNODE(nd_alltracelist,l1,0);
3828: }
3829: if ( ret )
3830: cand = f4?nd_f4_trace(m,&perm):nd_gb_trace(m,ishomo || homo,&perm);
3831: if ( !ret || !cand ) {
3832: /* failure */
3833: if ( trace > 1 ) { *rp = 0; return; }
3834: else m = get_lprime(++mindex);
3835: continue;
3836: }
1.15 noro 3837: if ( nd_gentrace ) {
3838: MKVECT(hvect,nd_psn);
3839: for ( i = 0; i < nd_psn; i++ )
3840: ndltodp(nd_psh[i]->dl,(DP *)&BDY(hvect)[i]);
3841: }
1.1 noro 3842: if ( !ishomo && homo ) {
3843: /* dehomogenization */
3844: for ( t = cand; t; t = NEXT(t) ) ndv_dehomogenize((NDV)BDY(t),ord);
3845: nd_init_ord(ord);
3846: nd_setup_parameters(nvar,0);
3847: }
3848: nd_demand = 0;
3849: cand = ndv_reducebase(cand,perm);
3850: if ( nd_gentrace ) { tl1 = nd_alltracelist; nd_alltracelist = 0; }
3851: cand = ndv_reduceall(0,cand);
3852: cbpe = nd_bpe;
3853: if ( nd_gentrace ) { tl2 = nd_alltracelist; nd_alltracelist = 0; }
3854: get_eg(&eg0);
3855: if ( nocheck )
3856: break;
3857: if ( (ret = ndv_check_membership(0,in0,obpe,oadv,oepos,cand)) != 0 ) {
3858: if ( nd_gentrace ) {
3859: tl3 = nd_alltracelist; nd_alltracelist = 0;
3860: } else tl3 = 0;
3861: /* gbcheck : cand is a GB of Id(cand) ? */
3862: if ( nd_vc || nd_gentrace || nd_gensyz )
3863: ret = nd_gb(0,0,1,nd_gensyz?1:0,0)!=0;
3864: else
3865: ret = nd_f4(0,1,0)!=0;
3866: if ( nd_gentrace && nd_gensyz ) {
3867: tl4 = nd_alltracelist; nd_alltracelist = 0;
3868: } else tl4 = 0;
3869: }
3870: if ( ret ) break;
3871: else if ( trace > 1 ) {
3872: /* failure */
3873: *rp = 0; return;
3874: } else {
3875: /* try the next modulus */
3876: m = get_lprime(++mindex);
3877: /* reset the parameters */
3878: if ( !ishomo && homo ) {
3879: nd_init_ord(ord1);
3880: nd_setup_parameters(nvar+1,wmax);
3881: } else {
3882: nd_init_ord(ord);
3883: nd_setup_parameters(nvar,max);
3884: }
3885: }
3886: }
3887: get_eg(&eg1); init_eg(&eg_check); add_eg(&eg_check,&eg0,&eg1);
3888: if ( DP_Print )
1.6 noro 3889: fprintf(asir_out,"check=%.3fsec\n",eg_check.exectime);
1.1 noro 3890: /* dp->p */
3891: nd_bpe = cbpe;
3892: nd_setup_parameters(nd_nvar,0);
3893: for ( r = cand; r; r = NEXT(r) ) {
1.16 noro 3894: if ( nd_module ) {
1.17 noro 3895: if ( retdp ) BDY(r) = ndvtodpm(0,BDY(r));
1.16 noro 3896: else BDY(r) = ndvtopl(0,CO,vv,BDY(r),mrank);
1.17 noro 3897: } else if ( retdp ) BDY(r) = ndvtodp(0,BDY(r));
3898: else BDY(r) = (pointer)ndvtop(0,CO,vv,BDY(r));
1.1 noro 3899: }
3900: if ( nd_nalg )
3901: cand = postprocess_algcoef(av,alist,cand);
3902: MKLIST(*rp,cand);
3903: if ( nd_gentrace ) {
3904: tl1 = reverse_node(tl1); tl2 = reverse_node(tl2);
3905: tl3 = reverse_node(tl3);
3906: /* tl2 = [[i,[[*,j,*,*],...]],...] */
3907: for ( t = tl2; t; t = NEXT(t) ) {
3908: /* s = [i,[*,j,*,*],...] */
3909: s = BDY((LIST)BDY(t));
1.6 noro 3910: j = perm[ZTOS((Q)ARG0(s))]; STOZ(j,jq); ARG0(s) = (pointer)jq;
1.1 noro 3911: for ( s = BDY((LIST)ARG1(s)); s; s = NEXT(s) ) {
1.6 noro 3912: j = perm[ZTOS((Q)ARG1(BDY((LIST)BDY(s))))]; STOZ(j,jq);
1.1 noro 3913: ARG1(BDY((LIST)BDY(s))) = (pointer)jq;
3914: }
3915: }
3916: for ( j = length(cand)-1, t = 0; j >= 0; j-- ) {
1.6 noro 3917: STOZ(perm[j],jq); MKNODE(s,jq,t); t = s;
1.1 noro 3918: }
3919: MKLIST(l1,tl1); MKLIST(l2,tl2); MKLIST(l3,t); MKLIST(l4,tl3);
3920: MKLIST(l5,tl4);
1.6 noro 3921: STOZ(nd_bpe,bpe);
1.15 noro 3922: tr = mknode(9,*rp,(!ishomo&&homo)?ONE:0,l1,l2,l3,l4,l5,bpe,hvect); MKLIST(*rp,tr);
1.1 noro 3923: }
3924: }
3925:
3926: /* XXX : module element is not considered */
3927:
3928: void dltondl(int n,DL dl,UINT *r)
3929: {
3930: UINT *d;
3931: int i,j,l,s,ord_l;
3932: struct order_pair *op;
3933:
3934: d = (unsigned int *)dl->d;
3935: for ( i = 0; i < nd_wpd; i++ ) r[i] = 0;
3936: if ( nd_blockmask ) {
3937: l = nd_blockmask->n;
3938: op = nd_blockmask->order_pair;
3939: for ( j = 0, s = 0; j < l; j++ ) {
3940: ord_l = op[j].length;
3941: for ( i = 0; i < ord_l; i++, s++ ) PUT_EXP(r,s,d[s]);
3942: }
3943: TD(r) = ndl_weight(r);
3944: ndl_weight_mask(r);
3945: } else {
3946: for ( i = 0; i < n; i++ ) PUT_EXP(r,i,d[i]);
3947: TD(r) = ndl_weight(r);
3948: }
3949: }
3950:
3951: DL ndltodl(int n,UINT *ndl)
3952: {
3953: DL dl;
3954: int *d;
3955: int i,j,l,s,ord_l;
3956: struct order_pair *op;
3957:
3958: NEWDL(dl,n);
3959: dl->td = TD(ndl);
3960: d = dl->d;
3961: if ( nd_blockmask ) {
3962: l = nd_blockmask->n;
3963: op = nd_blockmask->order_pair;
3964: for ( j = 0, s = 0; j < l; j++ ) {
3965: ord_l = op[j].length;
3966: for ( i = 0; i < ord_l; i++, s++ ) d[s] = GET_EXP(ndl,s);
3967: }
3968: } else {
3969: for ( i = 0; i < n; i++ ) d[i] = GET_EXP(ndl,i);
3970: }
3971: return dl;
3972: }
3973:
3974: void nmtodp(int mod,NM m,DP *r)
3975: {
3976: DP dp;
3977: MP mr;
3978:
3979: NEWMP(mr);
3980: mr->dl = ndltodl(nd_nvar,DL(m));
3981: mr->c = (Obj)ndctop(mod,m->c);
3982: NEXT(mr) = 0; MKDP(nd_nvar,mr,dp); dp->sugar = mr->dl->td;
3983: *r = dp;
3984: }
3985:
1.15 noro 3986: void ndltodp(UINT *d,DP *r)
3987: {
3988: DP dp;
3989: MP mr;
3990:
3991: NEWMP(mr);
3992: mr->dl = ndltodl(nd_nvar,d);
3993: mr->c = (Obj)ONE;
3994: NEXT(mr) = 0; MKDP(nd_nvar,mr,dp); dp->sugar = mr->dl->td;
3995: *r = dp;
3996: }
3997:
1.1 noro 3998: void ndl_print(UINT *dl)
3999: {
4000: int n;
4001: int i,j,l,ord_l,s,s0;
4002: struct order_pair *op;
4003:
4004: n = nd_nvar;
4005: printf("<<");
4006: if ( nd_blockmask ) {
4007: l = nd_blockmask->n;
4008: op = nd_blockmask->order_pair;
4009: for ( j = 0, s = s0 = 0; j < l; j++ ) {
4010: ord_l = op[j].length;
4011: for ( i = 0; i < ord_l; i++, s++ )
4012: printf(s==n-1?"%d":"%d,",GET_EXP(dl,s));
4013: }
4014: } else {
4015: for ( i = 0; i < n; i++ ) printf(i==n-1?"%d":"%d,",GET_EXP(dl,i));
4016: }
4017: printf(">>");
4018: if ( nd_module && MPOS(dl) )
4019: printf("*e%d",MPOS(dl));
4020: }
4021:
4022: void nd_print(ND p)
4023: {
4024: NM m;
4025:
4026: if ( !p )
4027: printf("0\n");
4028: else {
4029: for ( m = BDY(p); m; m = NEXT(m) ) {
4030: if ( CM(m) & 0x80000000 ) printf("+@_%d*",IFTOF(CM(m)));
4031: else printf("+%d*",CM(m));
4032: ndl_print(DL(m));
4033: }
4034: printf("\n");
4035: }
4036: }
4037:
4038: void nd_print_q(ND p)
4039: {
4040: NM m;
4041:
4042: if ( !p )
4043: printf("0\n");
4044: else {
4045: for ( m = BDY(p); m; m = NEXT(m) ) {
4046: printf("+");
1.6 noro 4047: printexpr(CO,(Obj)CZ(m));
1.1 noro 4048: printf("*");
4049: ndl_print(DL(m));
4050: }
4051: printf("\n");
4052: }
4053: }
4054:
4055: void ndp_print(ND_pairs d)
4056: {
4057: ND_pairs t;
4058:
4059: for ( t = d; t; t = NEXT(t) ) printf("%d,%d ",t->i1,t->i2);
4060: printf("\n");
4061: }
4062:
4063: void nd_removecont(int mod,ND p)
4064: {
4065: int i,n;
4066: Z *w;
4067: NM m;
4068: struct oVECT v;
4069:
4070: if ( mod == -1 ) nd_mul_c(mod,p,_invsf(HCM(p)));
4071: else if ( mod == -2 ) {
4072: Z inv;
4073: divlf(ONE,HCZ(p),&inv);
4074: nd_mul_c_lf(p,inv);
4075: } else if ( mod ) nd_mul_c(mod,p,invm(HCM(p),mod));
4076: else {
4077: for ( m = BDY(p), n = 0; m; m = NEXT(m), n++ );
4078: w = (Z *)MALLOC(n*sizeof(Q));
4079: v.len = n;
4080: v.body = (pointer *)w;
1.6 noro 4081: for ( m = BDY(p), i = 0; i < n; m = NEXT(m), i++ ) w[i] = CZ(m);
1.1 noro 4082: removecont_array((P *)w,n,1);
1.6 noro 4083: for ( m = BDY(p), i = 0; i < n; m = NEXT(m), i++ ) CZ(m) = w[i];
1.1 noro 4084: }
4085: }
4086:
4087: void nd_removecont2(ND p1,ND p2)
4088: {
4089: int i,n1,n2,n;
4090: Z *w;
4091: NM m;
4092: struct oVECT v;
4093:
4094: n1 = nd_length(p1);
4095: n2 = nd_length(p2);
4096: n = n1+n2;
4097: w = (Z *)MALLOC(n*sizeof(Q));
4098: v.len = n;
4099: v.body = (pointer *)w;
4100: i = 0;
4101: if ( p1 )
1.6 noro 4102: for ( m = BDY(p1); i < n1; m = NEXT(m), i++ ) w[i] = CZ(m);
1.1 noro 4103: if ( p2 )
1.6 noro 4104: for ( m = BDY(p2); i < n; m = NEXT(m), i++ ) w[i] = CZ(m);
1.1 noro 4105: removecont_array((P *)w,n,1);
4106: i = 0;
4107: if ( p1 )
1.6 noro 4108: for ( m = BDY(p1); i < n1; m = NEXT(m), i++ ) CZ(m) = w[i];
1.1 noro 4109: if ( p2 )
1.6 noro 4110: for ( m = BDY(p2); i < n; m = NEXT(m), i++ ) CZ(m) = w[i];
1.1 noro 4111: }
4112:
4113: void ndv_removecont(int mod,NDV p)
4114: {
4115: int i,len,all_p;
4116: Z *c;
4117: P *w;
4118: Z dvr,t;
4119: P g,cont,tp;
4120: NMV m;
4121:
4122: if ( mod == -1 )
4123: ndv_mul_c(mod,p,_invsf(HCM(p)));
4124: else if ( mod == -2 ) {
4125: Z inv;
4126: divlf(ONE,HCZ(p),&inv);
4127: ndv_mul_c_lf(p,inv);
4128: } else if ( mod )
4129: ndv_mul_c(mod,p,invm(HCM(p),mod));
4130: else {
4131: len = p->len;
4132: w = (P *)MALLOC(len*sizeof(P));
4133: c = (Z *)MALLOC(len*sizeof(Q));
4134: for ( m = BDY(p), all_p = 1, i = 0; i < len; NMV_ADV(m), i++ ) {
4135: ptozp(CP(m),1,(Q *)&c[i],&w[i]);
4136: all_p = all_p && !NUM(w[i]);
4137: }
4138: if ( all_p ) {
4139: qltozl((Q *)c,len,&dvr); nd_heu_nezgcdnpz(nd_vc,w,len,1,&g);
4140: mulp(nd_vc,(P)dvr,g,&cont);
4141: for ( m = BDY(p), i = 0; i < len; NMV_ADV(m), i++ ) {
4142: divsp(nd_vc,CP(m),cont,&tp); CP(m) = tp;
4143: }
4144: } else {
4145: sortbynm((Q *)c,len);
4146: qltozl((Q *)c,len,&dvr);
4147: for ( m = BDY(p), i = 0; i < len; NMV_ADV(m), i++ ) {
4148: divsp(nd_vc,CP(m),(P)dvr,&tp); CP(m) = tp;
4149: }
4150: }
4151: }
4152: }
4153:
4154: /* koko */
4155:
4156: void ndv_homogenize(NDV p,int obpe,int oadv,EPOS oepos,int ompos)
4157: {
4158: int len,i,max;
4159: NMV m,mr0,mr,t;
4160:
4161: len = p->len;
1.14 noro 4162: for ( m = BDY(p), i = 0, max = 0; i < len; NMV_OADV(m), i++ )
1.1 noro 4163: max = MAX(max,TD(DL(m)));
4164: mr0 = nmv_adv>oadv?(NMV)REALLOC(BDY(p),len*nmv_adv):BDY(p);
4165: m = (NMV)((char *)mr0+(len-1)*oadv);
4166: mr = (NMV)((char *)mr0+(len-1)*nmv_adv);
4167: t = (NMV)MALLOC(nmv_adv);
4168: for ( i = 0; i < len; i++, NMV_OPREV(m), NMV_PREV(mr) ) {
4169: ndl_homogenize(DL(m),DL(t),obpe,oepos,ompos,max);
1.6 noro 4170: CZ(mr) = CZ(m);
1.1 noro 4171: ndl_copy(DL(t),DL(mr));
4172: }
4173: NV(p)++;
4174: BDY(p) = mr0;
4175: }
4176:
4177: void ndv_dehomogenize(NDV p,struct order_spec *ord)
4178: {
4179: int i,j,adj,len,newnvar,newwpd,newadv,newexporigin,newmpos;
4180: int pos;
4181: Q *w;
4182: Q dvr,t;
4183: NMV m,r;
4184:
4185: len = p->len;
4186: newnvar = nd_nvar-1;
4187: newexporigin = nd_get_exporigin(ord);
4188: if ( nd_module ) newmpos = newexporigin-1;
4189: newwpd = newnvar/nd_epw+(newnvar%nd_epw?1:0)+newexporigin;
4190: for ( m = BDY(p), i = 0; i < len; NMV_ADV(m), i++ )
4191: ndl_dehomogenize(DL(m));
4192: if ( newwpd != nd_wpd ) {
4193: newadv = ROUND_FOR_ALIGN(sizeof(struct oNMV)+(newwpd-1)*sizeof(UINT));
4194: for ( m = r = BDY(p), i = 0; i < len; NMV_ADV(m), NDV_NADV(r), i++ ) {
1.6 noro 4195: CZ(r) = CZ(m);
1.1 noro 4196: if ( nd_module ) pos = MPOS(DL(m));
4197: for ( j = 0; j < newexporigin; j++ ) DL(r)[j] = DL(m)[j];
4198: adj = nd_exporigin-newexporigin;
4199: for ( ; j < newwpd; j++ ) DL(r)[j] = DL(m)[j+adj];
4200: if ( nd_module ) {
4201: DL(r)[newmpos] = pos;
4202: }
4203: }
4204: }
4205: NV(p)--;
4206: }
4207:
4208: void nd_heu_nezgcdnpz(VL vl,P *pl,int m,int full,P *pr)
4209: {
4210: int i;
4211: P *tpl,*tpl1;
4212: NODE l;
4213: P h,gcd,t;
4214:
4215: tpl = (P *)MALLOC(m*sizeof(P));
4216: tpl1 = (P *)MALLOC(m*sizeof(P));
4217: bcopy(pl,tpl,m*sizeof(P));
4218: gcd = (P)ONE;
4219: for ( l = nd_hcf; l; l = NEXT(l) ) {
4220: h = (P)BDY(l);
4221: while ( 1 ) {
4222: for ( i = 0; i < m; i++ )
4223: if ( !divtpz(vl,tpl[i],h,&tpl1[i]) )
4224: break;
4225: if ( i == m ) {
4226: bcopy(tpl1,tpl,m*sizeof(P));
4227: mulp(vl,gcd,h,&t); gcd = t;
4228: } else
4229: break;
4230: }
4231: }
4232: if ( DP_Print > 2 ){fprintf(asir_out,"[%d]",nmonop(gcd)); fflush(asir_out);}
4233: if ( full ) {
4234: heu_nezgcdnpz(vl,tpl,m,&t);
4235: mulp(vl,gcd,t,pr);
4236: } else
4237: *pr = gcd;
4238: }
4239:
4240: void removecont_array(P *p,int n,int full)
4241: {
4242: int all_p,all_q,i;
4243: Z *c;
4244: P *w;
4245: P t,s;
4246:
4247: for ( all_q = 1, i = 0; i < n; i++ )
4248: all_q = all_q && NUM(p[i]);
4249: if ( all_q ) {
4250: removecont_array_q((Z *)p,n);
4251: } else {
4252: c = (Z *)MALLOC(n*sizeof(Z));
4253: w = (P *)MALLOC(n*sizeof(P));
4254: for ( i = 0; i < n; i++ ) {
4255: ptozp(p[i],1,(Q *)&c[i],&w[i]);
4256: }
4257: removecont_array_q(c,n);
4258: nd_heu_nezgcdnpz(nd_vc,w,n,full,&t);
4259: for ( i = 0; i < n; i++ ) {
4260: divsp(nd_vc,w[i],t,&s); mulp(nd_vc,s,(P)c[i],&p[i]);
4261: }
4262: }
4263: }
4264:
4265: /* c is an int array */
4266:
4267: void removecont_array_q(Z *c,int n)
4268: {
4269: struct oVECT v;
4270: Z d0,d1,a,u,u1,gcd;
4271: int i,j;
4272: Z *q,*r;
4273:
4274: q = (Z *)MALLOC(n*sizeof(Z));
4275: r = (Z *)MALLOC(n*sizeof(Z));
4276: v.id = O_VECT; v.len = n; v.body = (pointer *)c;
4277: gcdvz_estimate(&v,&d0);
4278: for ( i = 0; i < n; i++ ) {
4279: divqrz(c[i],d0,&q[i],&r[i]);
4280: }
4281: for ( i = 0; i < n; i++ ) if ( r[i] ) break;
4282: if ( i < n ) {
4283: v.id = O_VECT; v.len = n; v.body = (pointer *)r;
4284: gcdvz(&v,&d1);
4285: gcdz(d0,d1,&gcd);
1.6 noro 4286: /* exact division */
4287: divsz(d0,gcd,&a);
1.1 noro 4288: for ( i = 0; i < n; i++ ) {
4289: mulz(a,q[i],&u);
4290: if ( r[i] ) {
1.6 noro 4291: /* exact division */
4292: divsz(r[i],gcd,&u1);
1.1 noro 4293: addz(u,u1,&q[i]);
4294: } else
4295: q[i] = u;
4296: }
4297: }
4298: for ( i = 0; i < n; i++ ) c[i] = q[i];
4299: }
4300:
1.4 noro 4301: void gcdv_mpz_estimate(mpz_t d0,mpz_t *c,int n);
4302:
4303: void mpz_removecont_array(mpz_t *c,int n)
4304: {
4305: mpz_t d0,a,u,u1,gcd;
4306: int i,j;
1.13 noro 4307: static mpz_t *q,*r;
4308: static int c_len = 0;
1.4 noro 4309:
4310: for ( i = 0; i < n; i++ )
4311: if ( mpz_sgn(c[i]) ) break;
4312: if ( i == n ) return;
4313: gcdv_mpz_estimate(d0,c,n);
1.13 noro 4314: if ( n > c_len ) {
4315: q = (mpz_t *)MALLOC(n*sizeof(mpz_t));
4316: r = (mpz_t *)MALLOC(n*sizeof(mpz_t));
4317: c_len = n;
4318: }
1.4 noro 4319: for ( i = 0; i < n; i++ ) {
4320: mpz_init(q[i]); mpz_init(r[i]);
4321: mpz_fdiv_qr(q[i],r[i],c[i],d0);
4322: }
4323: for ( i = 0; i < n; i++ )
4324: if ( mpz_sgn(r[i]) ) break;
4325: mpz_init(gcd); mpz_init(a); mpz_init(u); mpz_init(u1);
4326: if ( i < n ) {
4327: mpz_gcd(gcd,d0,r[i]);
4328: for ( j = i+1; j < n; j++ ) mpz_gcd(gcd,gcd,r[j]);
4329: mpz_div(a,d0,gcd);
4330: for ( i = 0; i < n; i++ ) {
4331: mpz_mul(u,a,q[i]);
4332: if ( mpz_sgn(r[i]) ) {
4333: mpz_div(u1,r[i],gcd);
4334: mpz_add(q[i],u,u1);
4335: } else
4336: mpz_set(q[i],u);
4337: }
4338: }
4339: for ( i = 0; i < n; i++ )
4340: mpz_set(c[i],q[i]);
4341: }
4342:
1.1 noro 4343: void nd_mul_c(int mod,ND p,int mul)
4344: {
4345: NM m;
4346: int c,c1;
4347:
4348: if ( !p ) return;
4349: if ( mul == 1 ) return;
4350: if ( mod == -1 )
4351: for ( m = BDY(p); m; m = NEXT(m) )
4352: CM(m) = _mulsf(CM(m),mul);
4353: else
4354: for ( m = BDY(p); m; m = NEXT(m) ) {
4355: c1 = CM(m); DMAR(c1,mul,0,mod,c); CM(m) = c;
4356: }
4357: }
4358:
4359: void nd_mul_c_lf(ND p,Z mul)
4360: {
4361: NM m;
4362: Z c;
4363:
4364: if ( !p ) return;
4365: if ( UNIZ(mul) ) return;
4366: for ( m = BDY(p); m; m = NEXT(m) ) {
4367: mullf(CZ(m),mul,&c); CZ(m) = c;
4368: }
4369: }
4370:
4371: void nd_mul_c_q(ND p,P mul)
4372: {
4373: NM m;
4374: P c;
4375:
4376: if ( !p ) return;
4377: if ( UNIQ(mul) ) return;
4378: for ( m = BDY(p); m; m = NEXT(m) ) {
4379: mulp(nd_vc,CP(m),mul,&c); CP(m) = c;
4380: }
4381: }
4382:
4383: void nd_mul_c_p(VL vl,ND p,P mul)
4384: {
4385: NM m;
4386: P c;
4387:
4388: if ( !p ) return;
4389: for ( m = BDY(p); m; m = NEXT(m) ) {
4390: mulp(vl,CP(m),mul,&c); CP(m) = c;
4391: }
4392: }
4393:
4394: void nd_free(ND p)
4395: {
4396: NM t,s;
4397:
4398: if ( !p ) return;
4399: t = BDY(p);
4400: while ( t ) {
4401: s = NEXT(t);
4402: FREENM(t);
4403: t = s;
4404: }
4405: FREEND(p);
4406: }
4407:
4408: void ndv_free(NDV p)
4409: {
4410: GCFREE(BDY(p));
4411: }
4412:
4413: void nd_append_red(UINT *d,int i)
4414: {
4415: RHist m,m0;
4416: int h;
4417:
4418: NEWRHist(m);
4419: h = ndl_hash_value(d);
4420: m->index = i;
4421: ndl_copy(d,DL(m));
4422: NEXT(m) = nd_red[h];
4423: nd_red[h] = m;
4424: }
4425:
4426: UINT *ndv_compute_bound(NDV p)
4427: {
4428: UINT *d1,*d2,*t;
4429: UINT u;
4430: int i,j,k,l,len,ind;
4431: NMV m;
4432:
4433: if ( !p )
4434: return 0;
4435: d1 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
4436: d2 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
4437: len = LEN(p);
4438: m = BDY(p); ndl_copy(DL(m),d1); NMV_ADV(m);
4439: for ( i = 1; i < len; i++, NMV_ADV(m) ) {
4440: ndl_max(DL(m),d1,d2);
4441: t = d1; d1 = d2; d2 = t;
4442: }
4443: l = nd_nvar+31;
4444: t = (UINT *)MALLOC_ATOMIC(l*sizeof(UINT));
4445: for ( i = nd_exporigin, ind = 0; i < nd_wpd; i++ ) {
4446: u = d1[i];
4447: k = (nd_epw-1)*nd_bpe;
4448: for ( j = 0; j < nd_epw; j++, k -= nd_bpe, ind++ )
4449: t[ind] = (u>>k)&nd_mask0;
4450: }
4451: for ( ; ind < l; ind++ ) t[ind] = 0;
4452: return t;
4453: }
4454:
4455: UINT *nd_compute_bound(ND p)
4456: {
4457: UINT *d1,*d2,*t;
4458: UINT u;
4459: int i,j,k,l,len,ind;
4460: NM m;
4461:
4462: if ( !p )
4463: return 0;
4464: d1 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
4465: d2 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
4466: len = LEN(p);
4467: m = BDY(p); ndl_copy(DL(m),d1); m = NEXT(m);
4468: for ( m = NEXT(m); m; m = NEXT(m) ) {
4469: ndl_lcm(DL(m),d1,d2);
4470: t = d1; d1 = d2; d2 = t;
4471: }
4472: l = nd_nvar+31;
4473: t = (UINT *)MALLOC_ATOMIC(l*sizeof(UINT));
4474: for ( i = nd_exporigin, ind = 0; i < nd_wpd; i++ ) {
4475: u = d1[i];
4476: k = (nd_epw-1)*nd_bpe;
4477: for ( j = 0; j < nd_epw; j++, k -= nd_bpe, ind++ )
4478: t[ind] = (u>>k)&nd_mask0;
4479: }
4480: for ( ; ind < l; ind++ ) t[ind] = 0;
4481: return t;
4482: }
4483:
4484: /* if nd_module == 1 then d[nd_exporigin-1] indicates the position */
4485: /* of a term. In this case we need additional 1 word. */
4486:
4487: int nd_get_exporigin(struct order_spec *ord)
4488: {
4489: switch ( ord->id ) {
4490: case 0: case 2: case 256: case 258:
4491: return 1+nd_module;
4492: case 1: case 257:
4493: /* block order */
4494: /* poly ring d[0]:weight d[1]:w0,...,d[nd_exporigin-1]:w(n-1) */
4495: /* module d[0]:weight d[1]:w0,...,d[nd_exporigin-2]:w(n-1) */
4496: return ord->ord.block.length+1+nd_module;
4497: case 3: case 259:
4498: #if 0
4499: error("nd_get_exporigin : composite order is not supported yet.");
4500: #else
4501: return 1+nd_module;
4502: #endif
4503: default:
4504: error("nd_get_exporigin : ivalid argument.");
4505: return 0;
4506: }
4507: }
4508:
4509: void nd_setup_parameters(int nvar,int max) {
4510: int i,j,n,elen,ord_o,ord_l,l,s,wpd;
4511: struct order_pair *op;
4512:
4513: nd_nvar = nvar;
4514: if ( max ) {
4515: /* XXX */
4516: if ( do_weyl ) nd_bpe = 32;
4517: else if ( max < 2 ) nd_bpe = 1;
4518: else if ( max < 4 ) nd_bpe = 2;
4519: else if ( max < 8 ) nd_bpe = 3;
4520: else if ( max < 16 ) nd_bpe = 4;
4521: else if ( max < 32 ) nd_bpe = 5;
4522: else if ( max < 64 ) nd_bpe = 6;
4523: else if ( max < 256 ) nd_bpe = 8;
4524: else if ( max < 1024 ) nd_bpe = 10;
4525: else if ( max < 65536 ) nd_bpe = 16;
4526: else nd_bpe = 32;
4527: }
4528: if ( !do_weyl && weight_check && (current_dl_weight_vector || nd_matrix) ) {
4529: UINT t;
4530: int st;
4531: int *v;
4532: /* t = max(weights) */
4533: t = 0;
4534: if ( current_dl_weight_vector )
4535: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
4536: if ( (st=current_dl_weight_vector[i]) < 0 ) st = -st;
4537: if ( t < st ) t = st;
4538: }
4539: if ( nd_matrix )
4540: for ( i = 0; i < nd_matrix_len; i++ )
4541: for ( j = 0, v = nd_matrix[i]; j < nd_nvar; j++ ) {
4542: if ( (st=v[j]) < 0 ) st = -st;
4543: if ( t < st ) t = st;
4544: }
4545: /* i = bitsize of t */
4546: for ( i = 0; t; t >>=1, i++ );
4547: /* i += bitsize of nd_nvar */
4548: for ( t = nd_nvar; t; t >>=1, i++);
4549: /* nd_bpe+i = bitsize of max(weights)*max(exp)*nd_nvar */
4550: if ( (nd_bpe+i) >= 31 )
4551: error("nd_setup_parameters : too large weight");
4552: }
4553: nd_epw = (sizeof(UINT)*8)/nd_bpe;
4554: elen = nd_nvar/nd_epw+(nd_nvar%nd_epw?1:0);
4555: nd_exporigin = nd_get_exporigin(nd_ord);
4556: wpd = nd_exporigin+elen;
4557: if ( nd_module )
4558: nd_mpos = nd_exporigin-1;
4559: else
4560: nd_mpos = -1;
4561: if ( wpd != nd_wpd ) {
4562: nd_free_private_storage();
4563: nd_wpd = wpd;
4564: }
4565: if ( nd_bpe < 32 ) {
4566: nd_mask0 = (1<<nd_bpe)-1;
4567: } else {
4568: nd_mask0 = 0xffffffff;
4569: }
4570: bzero(nd_mask,sizeof(nd_mask));
4571: nd_mask1 = 0;
4572: for ( i = 0; i < nd_epw; i++ ) {
4573: nd_mask[nd_epw-i-1] = (nd_mask0<<(i*nd_bpe));
4574: nd_mask1 |= (1<<(nd_bpe-1))<<(i*nd_bpe);
4575: }
4576: nmv_adv = ROUND_FOR_ALIGN(sizeof(struct oNMV)+(nd_wpd-1)*sizeof(UINT));
4577: nd_epos = nd_create_epos(nd_ord);
4578: nd_blockmask = nd_create_blockmask(nd_ord);
4579: nd_work_vector = (int *)REALLOC(nd_work_vector,nd_nvar*sizeof(int));
4580: }
4581:
4582: ND_pairs nd_reconstruct(int trace,ND_pairs d)
4583: {
4584: int i,obpe,oadv,h;
4585: static NM prev_nm_free_list;
4586: static ND_pairs prev_ndp_free_list;
4587: RHist mr0,mr;
4588: RHist r;
4589: RHist *old_red;
4590: ND_pairs s0,s,t;
4591: EPOS oepos;
4592:
4593: obpe = nd_bpe;
4594: oadv = nmv_adv;
4595: oepos = nd_epos;
4596: if ( obpe < 2 ) nd_bpe = 2;
4597: else if ( obpe < 3 ) nd_bpe = 3;
4598: else if ( obpe < 4 ) nd_bpe = 4;
4599: else if ( obpe < 5 ) nd_bpe = 5;
4600: else if ( obpe < 6 ) nd_bpe = 6;
4601: else if ( obpe < 8 ) nd_bpe = 8;
4602: else if ( obpe < 10 ) nd_bpe = 10;
4603: else if ( obpe < 16 ) nd_bpe = 16;
4604: else if ( obpe < 32 ) nd_bpe = 32;
4605: else error("nd_reconstruct : exponent too large");
4606:
4607: nd_setup_parameters(nd_nvar,0);
4608: prev_nm_free_list = _nm_free_list;
4609: prev_ndp_free_list = _ndp_free_list;
4610: _nm_free_list = 0;
4611: _ndp_free_list = 0;
4612: for ( i = nd_psn-1; i >= 0; i-- ) {
4613: ndv_realloc(nd_ps[i],obpe,oadv,oepos);
4614: ndv_realloc(nd_ps_sym[i],obpe,oadv,oepos);
4615: }
4616: if ( trace )
4617: for ( i = nd_psn-1; i >= 0; i-- ) {
4618: ndv_realloc(nd_ps_trace[i],obpe,oadv,oepos);
4619: ndv_realloc(nd_ps_trace_sym[i],obpe,oadv,oepos);
4620: }
4621: s0 = 0;
4622: for ( t = d; t; t = NEXT(t) ) {
4623: NEXTND_pairs(s0,s);
4624: s->i1 = t->i1;
4625: s->i2 = t->i2;
4626: SG(s) = SG(t);
4627: ndl_reconstruct(LCM(t),LCM(s),obpe,oepos);
4628: }
4629:
4630: old_red = (RHist *)MALLOC(REDTAB_LEN*sizeof(RHist));
4631: for ( i = 0; i < REDTAB_LEN; i++ ) {
4632: old_red[i] = nd_red[i];
4633: nd_red[i] = 0;
4634: }
4635: for ( i = 0; i < REDTAB_LEN; i++ )
4636: for ( r = old_red[i]; r; r = NEXT(r) ) {
4637: NEWRHist(mr);
4638: mr->index = r->index;
4639: SG(mr) = SG(r);
4640: ndl_reconstruct(DL(r),DL(mr),obpe,oepos);
4641: h = ndl_hash_value(DL(mr));
4642: NEXT(mr) = nd_red[h];
4643: nd_red[h] = mr;
4644: }
4645: for ( i = 0; i < REDTAB_LEN; i++ ) old_red[i] = 0;
4646: old_red = 0;
4647: for ( i = 0; i < nd_psn; i++ ) {
4648: NEWRHist(r); SG(r) = SG(nd_psh[i]);
4649: ndl_reconstruct(DL(nd_psh[i]),DL(r),obpe,oepos);
4650: nd_psh[i] = r;
4651: }
4652: if ( s0 ) NEXT(s) = 0;
4653: prev_nm_free_list = 0;
4654: prev_ndp_free_list = 0;
4655: #if 0
4656: GC_gcollect();
4657: #endif
4658: return s0;
4659: }
4660:
4661: void ndl_reconstruct(UINT *d,UINT *r,int obpe,EPOS oepos)
4662: {
4663: int n,i,ei,oepw,omask0,j,s,ord_l,l;
4664: struct order_pair *op;
4665:
4666: n = nd_nvar;
4667: oepw = (sizeof(UINT)*8)/obpe;
4668: omask0 = (1<<obpe)-1;
4669: TD(r) = TD(d);
4670: for ( i = nd_exporigin; i < nd_wpd; i++ ) r[i] = 0;
4671: if ( nd_blockmask ) {
4672: l = nd_blockmask->n;
4673: op = nd_blockmask->order_pair;
4674: for ( i = 1; i < nd_exporigin; i++ )
4675: r[i] = d[i];
4676: for ( j = 0, s = 0; j < l; j++ ) {
4677: ord_l = op[j].length;
4678: for ( i = 0; i < ord_l; i++, s++ ) {
4679: ei = GET_EXP_OLD(d,s);
4680: PUT_EXP(r,s,ei);
4681: }
4682: }
4683: } else {
4684: for ( i = 0; i < n; i++ ) {
4685: ei = GET_EXP_OLD(d,i);
4686: PUT_EXP(r,i,ei);
4687: }
4688: }
4689: if ( nd_module ) MPOS(r) = MPOS(d);
4690: }
4691:
4692: ND nd_copy(ND p)
4693: {
4694: NM m,mr,mr0;
4695: int c,n;
4696: ND r;
4697:
4698: if ( !p )
4699: return 0;
4700: else {
4701: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
4702: NEXTNM(mr0,mr);
4703: CM(mr) = CM(m);
4704: ndl_copy(DL(m),DL(mr));
4705: }
4706: NEXT(mr) = 0;
4707: MKND(NV(p),mr0,LEN(p),r);
4708: SG(r) = SG(p);
4709: return r;
4710: }
4711: }
4712:
4713: int nd_sp(int mod,int trace,ND_pairs p,ND *rp)
4714: {
4715: NM m1,m2;
4716: NDV p1,p2;
4717: ND t1,t2;
4718: UINT *lcm;
4719: P gp,tp;
4720: Z g,t;
4721: Z iq;
4722: int td;
4723: LIST hist;
4724: NODE node;
4725: DP d;
4726:
4727: if ( !mod && nd_demand ) {
4728: p1 = ndv_load(p->i1); p2 = ndv_load(p->i2);
4729: } else {
4730: if ( trace ) {
4731: p1 = nd_ps_trace[p->i1]; p2 = nd_ps_trace[p->i2];
4732: } else {
4733: p1 = nd_ps[p->i1]; p2 = nd_ps[p->i2];
4734: }
4735: }
4736: lcm = LCM(p);
4737: NEWNM(m1); ndl_sub(lcm,HDL(p1),DL(m1));
4738: if ( ndl_check_bound2(p->i1,DL(m1)) ) {
4739: FREENM(m1); return 0;
4740: }
4741: NEWNM(m2); ndl_sub(lcm,HDL(p2),DL(m2));
4742: if ( ndl_check_bound2(p->i2,DL(m2)) ) {
4743: FREENM(m1); FREENM(m2); return 0;
4744: }
4745:
4746: if ( mod == -1 ) {
4747: CM(m1) = HCM(p2); CM(m2) = _chsgnsf(HCM(p1));
4748: } else if ( mod > 0 ) {
4749: CM(m1) = HCM(p2); CM(m2) = mod-HCM(p1);
4750: } else if ( mod == -2 ) {
4751: CZ(m1) = HCZ(p2); chsgnlf(HCZ(p1),&CZ(m2));
4752: } else if ( nd_vc ) {
4753: ezgcdpz(nd_vc,HCP(p1),HCP(p2),&gp);
4754: divsp(nd_vc,HCP(p2),gp,&CP(m1));
4755: divsp(nd_vc,HCP(p1),gp,&tp); chsgnp(tp,&CP(m2));
4756: } else {
1.6 noro 4757: igcd_cofactor(HCZ(p1),HCZ(p2),&g,&t,&CZ(m1)); chsgnz(t,&CZ(m2));
1.1 noro 4758: }
4759: t1 = ndv_mul_nm(mod,m1,p1); t2 = ndv_mul_nm(mod,m2,p2);
4760: *rp = nd_add(mod,t1,t2);
4761: if ( nd_gentrace ) {
4762: /* nd_tracelist is initialized */
1.6 noro 4763: STOZ(p->i1,iq); nmtodp(mod,m1,&d); node = mknode(4,ONE,iq,d,ONE);
1.1 noro 4764: MKLIST(hist,node); MKNODE(nd_tracelist,hist,0);
1.6 noro 4765: STOZ(p->i2,iq); nmtodp(mod,m2,&d); node = mknode(4,ONE,iq,d,ONE);
1.1 noro 4766: MKLIST(hist,node); MKNODE(node,hist,nd_tracelist);
4767: nd_tracelist = node;
4768: }
4769: FREENM(m1); FREENM(m2);
4770: return 1;
4771: }
4772:
4773: void ndv_mul_c(int mod,NDV p,int mul)
4774: {
4775: NMV m;
4776: int c,c1,len,i;
4777:
4778: if ( !p ) return;
4779: len = LEN(p);
4780: if ( mod == -1 )
4781: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) )
4782: CM(m) = _mulsf(CM(m),mul);
4783: else
4784: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
4785: c1 = CM(m); DMAR(c1,mul,0,mod,c); CM(m) = c;
4786: }
4787: }
4788:
4789: void ndv_mul_c_lf(NDV p,Z mul)
4790: {
4791: NMV m;
4792: Z c;
4793: int len,i;
4794:
4795: if ( !p ) return;
4796: len = LEN(p);
4797: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
4798: mullf(CZ(m),mul,&c); CZ(m) = c;
4799: }
4800: }
4801:
4802: /* for nd_det */
4803: void ndv_mul_c_q(NDV p,Z mul)
4804: {
4805: NMV m;
4806: Z c;
4807: int len,i;
4808:
4809: if ( !p ) return;
4810: len = LEN(p);
4811: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
1.6 noro 4812: mulz(CZ(m),mul,&c); CZ(m) = c;
1.1 noro 4813: }
4814: }
4815:
4816: ND weyl_ndv_mul_nm(int mod,NM m0,NDV p) {
4817: int n2,i,j,l,n,tlen;
4818: UINT *d0;
4819: NM *tab,*psum;
4820: ND s,r;
4821: NM t;
4822: NMV m1;
4823:
4824: if ( !p ) return 0;
4825: n = NV(p); n2 = n>>1;
4826: d0 = DL(m0);
4827: l = LEN(p);
4828: for ( i = 0, tlen = 1; i < n2; i++ ) tlen *= (GET_EXP(d0,n2+i)+1);
4829: tab = (NM *)MALLOC(tlen*sizeof(NM));
4830: psum = (NM *)MALLOC(tlen*sizeof(NM));
4831: for ( i = 0; i < tlen; i++ ) psum[i] = 0;
4832: m1 = (NMV)(((char *)BDY(p))+nmv_adv*(l-1));
4833: for ( i = l-1; i >= 0; i--, NMV_PREV(m1) ) {
4834: /* m0(NM) * m1(NMV) => tab(NM) */
4835: weyl_mul_nm_nmv(n,mod,m0,m1,tab,tlen);
4836: for ( j = 0; j < tlen; j++ ) {
4837: if ( tab[j] ) {
4838: NEXT(tab[j]) = psum[j]; psum[j] = tab[j];
4839: }
4840: }
4841: }
4842: for ( i = tlen-1, r = 0; i >= 0; i-- )
4843: if ( psum[i] ) {
4844: for ( j = 0, t = psum[i]; t; t = NEXT(t), j++ );
4845: MKND(n,psum[i],j,s);
4846: r = nd_add(mod,r,s);
4847: }
4848: if ( r ) SG(r) = SG(p)+TD(d0);
4849: return r;
4850: }
4851:
4852: /* product of monomials */
4853: /* XXX block order is not handled correctly */
4854:
4855: void weyl_mul_nm_nmv(int n,int mod,NM m0,NMV m1,NM *tab,int tlen)
4856: {
4857: int i,n2,j,s,curlen,homo,h,a,b,k,l,u,min;
4858: UINT *d0,*d1,*d,*dt,*ctab;
4859: Z *ctab_q;
4860: Z q,q1;
4861: UINT c0,c1,c;
4862: NM *p;
4863: NM m,t;
4864: int mpos;
4865:
4866: for ( i = 0; i < tlen; i++ ) tab[i] = 0;
4867: if ( !m0 || !m1 ) return;
4868: d0 = DL(m0); d1 = DL(m1); n2 = n>>1;
4869: if ( nd_module )
4870: if ( MPOS(d0) ) error("weyl_mul_nm_nmv : invalid operation");
4871:
4872: NEWNM(m); d = DL(m);
4873: if ( mod ) {
4874: c0 = CM(m0); c1 = CM(m1); DMAR(c0,c1,0,mod,c); CM(m) = c;
4875: } else if ( nd_vc )
4876: mulp(nd_vc,CP(m0),CP(m1),&CP(m));
4877: else
1.6 noro 4878: mulz(CZ(m0),CZ(m1),&CZ(m));
1.1 noro 4879: for ( i = 0; i < nd_wpd; i++ ) d[i] = 0;
4880: homo = n&1 ? 1 : 0;
4881: if ( homo ) {
4882: /* offset of h-degree */
4883: h = GET_EXP(d0,n-1)+GET_EXP(d1,n-1);
4884: PUT_EXP(DL(m),n-1,h);
4885: TD(DL(m)) = h;
4886: if ( nd_blockmask ) ndl_weight_mask(DL(m));
4887: }
4888: tab[0] = m;
4889: NEWNM(m); d = DL(m);
4890: for ( i = 0, curlen = 1; i < n2; i++ ) {
4891: a = GET_EXP(d0,i); b = GET_EXP(d1,n2+i);
4892: k = GET_EXP(d0,n2+i); l = GET_EXP(d1,i);
4893: /* xi^a*(Di^k*xi^l)*Di^b */
4894: a += l; b += k;
4895: s = MUL_WEIGHT(a,i)+MUL_WEIGHT(b,n2+i);
4896: if ( !k || !l ) {
4897: for ( j = 0; j < curlen; j++ )
4898: if ( (t = tab[j]) != 0 ) {
4899: dt = DL(t);
4900: PUT_EXP(dt,i,a); PUT_EXP(dt,n2+i,b); TD(dt) += s;
4901: if ( nd_blockmask ) ndl_weight_mask(dt);
4902: }
4903: curlen *= k+1;
4904: continue;
4905: }
4906: min = MIN(k,l);
4907: if ( mod ) {
4908: ctab = (UINT *)MALLOC((min+1)*sizeof(UINT));
4909: mkwcm(k,l,mod,(int *)ctab);
4910: } else {
4911: ctab_q = (Z *)MALLOC((min+1)*sizeof(Z));
4912: mkwc(k,l,ctab_q);
4913: }
4914: for ( j = min; j >= 0; j-- ) {
4915: for ( u = 0; u < nd_wpd; u++ ) d[u] = 0;
4916: PUT_EXP(d,i,a-j); PUT_EXP(d,n2+i,b-j);
4917: h = MUL_WEIGHT(a-j,i)+MUL_WEIGHT(b-j,n2+i);
4918: if ( homo ) {
4919: TD(d) = s;
4920: PUT_EXP(d,n-1,s-h);
4921: } else TD(d) = h;
4922: if ( nd_blockmask ) ndl_weight_mask(d);
4923: if ( mod ) c = ctab[j];
4924: else q = ctab_q[j];
4925: p = tab+curlen*j;
4926: if ( j == 0 ) {
4927: for ( u = 0; u < curlen; u++, p++ ) {
4928: if ( tab[u] ) {
4929: ndl_addto(DL(tab[u]),d);
4930: if ( mod ) {
4931: c0 = CM(tab[u]); DMAR(c0,c,0,mod,c1); CM(tab[u]) = c1;
4932: } else if ( nd_vc )
4933: mulp(nd_vc,CP(tab[u]),(P)q,&CP(tab[u]));
4934: else {
1.6 noro 4935: mulz(CZ(tab[u]),q,&q1); CZ(tab[u]) = q1;
1.1 noro 4936: }
4937: }
4938: }
4939: } else {
4940: for ( u = 0; u < curlen; u++, p++ ) {
4941: if ( tab[u] ) {
4942: NEWNM(t);
4943: ndl_add(DL(tab[u]),d,DL(t));
4944: if ( mod ) {
4945: c0 = CM(tab[u]); DMAR(c0,c,0,mod,c1); CM(t) = c1;
4946: } else if ( nd_vc )
4947: mulp(nd_vc,CP(tab[u]),(P)q,&CP(t));
4948: else
1.6 noro 4949: mulz(CZ(tab[u]),q,&CZ(t));
1.1 noro 4950: *p = t;
4951: }
4952: }
4953: }
4954: }
4955: curlen *= k+1;
4956: }
4957: FREENM(m);
4958: if ( nd_module ) {
4959: mpos = MPOS(d1);
4960: for ( i = 0; i < tlen; i++ )
4961: if ( tab[i] ) {
4962: d = DL(tab[i]);
4963: MPOS(d) = mpos;
4964: TD(d) = ndl_weight(d);
4965: }
4966: }
4967: }
4968:
4969: ND ndv_mul_nm_symbolic(NM m0,NDV p)
4970: {
4971: NM mr,mr0;
4972: NMV m;
4973: UINT *d,*dt,*dm;
4974: int c,n,td,i,c1,c2,len;
4975: Q q;
4976: ND r;
4977:
4978: if ( !p ) return 0;
4979: else {
4980: n = NV(p); m = BDY(p);
4981: d = DL(m0);
4982: len = LEN(p);
4983: mr0 = 0;
4984: td = TD(d);
4985: c = CM(m0);
4986: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
4987: NEXTNM(mr0,mr);
4988: CM(mr) = 1;
4989: ndl_add(DL(m),d,DL(mr));
4990: }
4991: NEXT(mr) = 0;
4992: MKND(NV(p),mr0,len,r);
4993: SG(r) = SG(p) + TD(d);
4994: return r;
4995: }
4996: }
4997:
4998: ND ndv_mul_nm(int mod,NM m0,NDV p)
4999: {
5000: NM mr,mr0;
5001: NMV m;
5002: UINT *d,*dt,*dm;
5003: int c,n,td,i,c1,c2,len;
5004: P q;
5005: ND r;
5006:
5007: if ( !p ) return 0;
5008: else if ( do_weyl ) {
5009: if ( mod < 0 ) {
5010: error("ndv_mul_nm : not implemented (weyl)");
5011: return 0;
5012: } else
5013: return weyl_ndv_mul_nm(mod,m0,p);
5014: } else {
5015: n = NV(p); m = BDY(p);
5016: d = DL(m0);
5017: len = LEN(p);
5018: mr0 = 0;
5019: td = TD(d);
5020: if ( mod == -1 ) {
5021: c = CM(m0);
5022: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5023: NEXTNM(mr0,mr);
5024: CM(mr) = _mulsf(CM(m),c);
5025: ndl_add(DL(m),d,DL(mr));
5026: }
5027: } else if ( mod == -2 ) {
5028: Z cl;
5029: cl = CZ(m0);
5030: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5031: NEXTNM(mr0,mr);
5032: mullf(CZ(m),cl,&CZ(mr));
5033: ndl_add(DL(m),d,DL(mr));
5034: }
5035: } else if ( mod ) {
5036: c = CM(m0);
5037: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5038: NEXTNM(mr0,mr);
5039: c1 = CM(m);
5040: DMAR(c1,c,0,mod,c2);
5041: CM(mr) = c2;
5042: ndl_add(DL(m),d,DL(mr));
5043: }
5044: } else {
5045: q = CP(m0);
5046: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5047: NEXTNM(mr0,mr);
5048: mulp(nd_vc,CP(m),q,&CP(mr));
5049: ndl_add(DL(m),d,DL(mr));
5050: }
5051: }
5052: NEXT(mr) = 0;
5053: MKND(NV(p),mr0,len,r);
5054: SG(r) = SG(p) + TD(d);
5055: return r;
5056: }
5057: }
5058:
5059: ND nd_quo(int mod,PGeoBucket bucket,NDV d)
5060: {
5061: NM mq0,mq;
5062: NMV tm;
5063: Q q;
5064: int i,nv,sg,c,c1,c2,hindex;
5065: ND p,t,r;
5066:
5067: if ( bucket->m < 0 ) return 0;
5068: else {
5069: nv = NV(d);
5070: mq0 = 0;
5071: tm = (NMV)MALLOC(nmv_adv);
5072: while ( 1 ) {
5073: if ( mod > 0 || mod == -1 )
5074: hindex = head_pbucket(mod,bucket);
5075: else if ( mod == -2 )
5076: hindex = head_pbucket_lf(bucket);
5077: else
5078: hindex = head_pbucket_q(bucket);
5079: if ( hindex < 0 ) break;
5080: p = bucket->body[hindex];
5081: NEXTNM(mq0,mq);
5082: ndl_sub(HDL(p),HDL(d),DL(mq));
5083: ndl_copy(DL(mq),DL(tm));
5084: if ( mod ) {
5085: c1 = invm(HCM(d),mod); c2 = HCM(p);
5086: DMAR(c1,c2,0,mod,c); CM(mq) = c;
5087: CM(tm) = mod-c;
5088: } else {
1.6 noro 5089: divsz(HCZ(p),HCZ(d),&CZ(mq));
5090: chsgnz(CZ(mq),&CZ(tm));
1.1 noro 5091: }
5092: t = ndv_mul_nmv_trunc(mod,tm,d,HDL(d));
5093: bucket->body[hindex] = nd_remove_head(p);
5094: t = nd_remove_head(t);
5095: add_pbucket(mod,bucket,t);
5096: }
5097: if ( !mq0 )
5098: r = 0;
5099: else {
5100: NEXT(mq) = 0;
5101: for ( i = 0, mq = mq0; mq; mq = NEXT(mq), i++ );
5102: MKND(nv,mq0,i,r);
5103: /* XXX */
5104: SG(r) = HTD(r);
5105: }
5106: return r;
5107: }
5108: }
5109:
5110: void ndv_realloc(NDV p,int obpe,int oadv,EPOS oepos)
5111: {
5112: NMV m,mr,mr0,t;
5113: int len,i,k;
5114:
5115: if ( !p ) return;
5116: m = BDY(p); len = LEN(p);
5117: mr0 = nmv_adv>oadv?(NMV)REALLOC(BDY(p),len*nmv_adv):BDY(p);
5118: m = (NMV)((char *)mr0+(len-1)*oadv);
5119: mr = (NMV)((char *)mr0+(len-1)*nmv_adv);
5120: t = (NMV)MALLOC(nmv_adv);
5121: for ( i = 0; i < len; i++, NMV_OPREV(m), NMV_PREV(mr) ) {
1.6 noro 5122: CZ(t) = CZ(m);
1.1 noro 5123: for ( k = 0; k < nd_wpd; k++ ) DL(t)[k] = 0;
5124: ndl_reconstruct(DL(m),DL(t),obpe,oepos);
1.6 noro 5125: CZ(mr) = CZ(t);
1.1 noro 5126: ndl_copy(DL(t),DL(mr));
5127: }
5128: BDY(p) = mr0;
5129: }
5130:
5131: NDV ndv_dup_realloc(NDV p,int obpe,int oadv,EPOS oepos)
5132: {
5133: NMV m,mr,mr0;
5134: int len,i;
5135: NDV r;
5136:
5137: if ( !p ) return 0;
5138: m = BDY(p); len = LEN(p);
5139: mr0 = mr = (NMV)MALLOC(len*nmv_adv);
5140: for ( i = 0; i < len; i++, NMV_OADV(m), NMV_ADV(mr) ) {
5141: ndl_zero(DL(mr));
5142: ndl_reconstruct(DL(m),DL(mr),obpe,oepos);
1.6 noro 5143: CZ(mr) = CZ(m);
1.1 noro 5144: }
5145: MKNDV(NV(p),mr0,len,r);
5146: SG(r) = SG(p);
5147: return r;
5148: }
5149:
5150: /* duplicate p */
5151:
5152: NDV ndv_dup(int mod,NDV p)
5153: {
5154: NDV d;
5155: NMV t,m,m0;
5156: int i,len;
5157:
5158: if ( !p ) return 0;
5159: len = LEN(p);
5160: m0 = m = (NMV)((mod>0 || mod==-1)?MALLOC_ATOMIC(len*nmv_adv):MALLOC(len*nmv_adv));
5161: for ( t = BDY(p), i = 0; i < len; i++, NMV_ADV(t), NMV_ADV(m) ) {
5162: ndl_copy(DL(t),DL(m));
1.6 noro 5163: CZ(m) = CZ(t);
1.1 noro 5164: }
5165: MKNDV(NV(p),m0,len,d);
5166: SG(d) = SG(p);
5167: return d;
5168: }
5169:
5170: NDV ndv_symbolic(int mod,NDV p)
5171: {
5172: NDV d;
5173: NMV t,m,m0;
5174: int i,len;
5175:
5176: if ( !p ) return 0;
5177: len = LEN(p);
5178: m0 = m = (NMV)((mod>0||mod==-1)?MALLOC_ATOMIC(len*nmv_adv):MALLOC(len*nmv_adv));
5179: for ( t = BDY(p), i = 0; i < len; i++, NMV_ADV(t), NMV_ADV(m) ) {
5180: ndl_copy(DL(t),DL(m));
1.6 noro 5181: CZ(m) = ONE;
1.1 noro 5182: }
5183: MKNDV(NV(p),m0,len,d);
5184: SG(d) = SG(p);
5185: return d;
5186: }
5187:
5188: ND nd_dup(ND p)
5189: {
5190: ND d;
5191: NM t,m,m0;
5192:
5193: if ( !p ) return 0;
5194: for ( m0 = 0, t = BDY(p); t; t = NEXT(t) ) {
5195: NEXTNM(m0,m);
5196: ndl_copy(DL(t),DL(m));
1.6 noro 5197: CZ(m) = CZ(t);
1.1 noro 5198: }
5199: if ( m0 ) NEXT(m) = 0;
5200: MKND(NV(p),m0,LEN(p),d);
5201: SG(d) = SG(p);
5202: return d;
5203: }
5204:
5205: /* XXX if p->len == 0 then it represents 0 */
5206:
5207: void ndv_mod(int mod,NDV p)
5208: {
5209: NMV t,d;
5210: int r,s,u;
5211: int i,len,dlen;
5212: P cp;
5213: Z c;
5214: Obj gfs;
5215:
5216: if ( !p ) return;
5217: len = LEN(p);
5218: dlen = 0;
5219: if ( mod == -1 )
5220: for ( t = d = BDY(p), i = 0; i < len; i++, NMV_ADV(t) ) {
5221: simp_ff((Obj)CP(t),&gfs);
5222: if ( gfs ) {
5223: r = FTOIF(CONT((GFS)gfs));
5224: CM(d) = r;
5225: ndl_copy(DL(t),DL(d));
5226: NMV_ADV(d);
5227: dlen++;
5228: }
5229: }
5230: else if ( mod == -2 )
5231: for ( t = d = BDY(p), i = 0; i < len; i++, NMV_ADV(t) ) {
5232: simp_ff((Obj)CP(t),&gfs);
5233: if ( gfs ) {
5234: lmtolf((LM)gfs,&CZ(d));
5235: ndl_copy(DL(t),DL(d));
5236: NMV_ADV(d);
5237: dlen++;
5238: }
5239: }
5240: else
5241: for ( t = d = BDY(p), i = 0; i < len; i++, NMV_ADV(t) ) {
5242: if ( nd_vc ) {
5243: nd_subst_vector(nd_vc,CP(t),nd_subst,&cp);
5244: c = (Z)cp;
5245: } else
1.6 noro 5246: c = CZ(t);
1.1 noro 5247: r = remqi((Q)c,mod);
5248: if ( r ) {
5249: CM(d) = r;
5250: ndl_copy(DL(t),DL(d));
5251: NMV_ADV(d);
5252: dlen++;
5253: }
5254: }
5255: LEN(p) = dlen;
5256: }
5257:
5258: NDV ptondv(VL vl,VL dvl,P p)
5259: {
5260: ND nd;
5261:
5262: nd = ptond(vl,dvl,p);
5263: return ndtondv(0,nd);
5264: }
5265:
5266: void pltozpl(LIST l,Q *cont,LIST *pp)
5267: {
1.16 noro 5268: NODE nd,nd1;
5269: int n;
5270: P *pl;
5271: Q *cl;
5272: int i;
5273: P dmy;
5274: Z dvr,inv;
5275: LIST r;
5276:
5277: nd = BDY(l); n = length(nd);
5278: pl = (P *)MALLOC(n*sizeof(P));
5279: cl = (Q *)MALLOC(n*sizeof(Q));
5280: for ( i = 0; i < n; i++, nd = NEXT(nd) ) {
5281: ptozp((P)BDY(nd),1,&cl[i],&dmy);
5282: }
5283: qltozl(cl,n,&dvr);
5284: divz(ONE,dvr,&inv);
5285: nd = BDY(l);
5286: for ( i = 0; i < n; i++, nd = NEXT(nd) )
5287: divsp(CO,(P)BDY(nd),(P)dvr,&pl[i]);
5288: nd = 0;
5289: for ( i = n-1; i >= 0; i-- ) {
5290: MKNODE(nd1,pl[i],nd); nd = nd1;
5291: }
5292: MKLIST(r,nd);
5293: *pp = r;
1.1 noro 5294: }
5295:
5296: /* (a1,a2,...,an) -> a1*e(1)+...+an*e(n) */
5297:
5298: NDV pltondv(VL vl,VL dvl,LIST p)
5299: {
5300: int i;
5301: NODE t;
5302: ND r,ri;
5303: NM m;
5304:
5305: if ( !nd_module ) error("pltond : module order must be set");
5306: r = 0;
5307: for ( i = 1, t = BDY(p); t; t = NEXT(t), i++ ) {
5308: ri = ptond(vl,dvl,(P)BDY(t));
5309: if ( ri )
5310: for ( m = BDY(ri); m; m = NEXT(m) ) {
5311: MPOS(DL(m)) = i;
5312: TD(DL(m)) = ndl_weight(DL(m));
5313: if ( nd_blockmask ) ndl_weight_mask(DL(m));
5314: }
5315: r = nd_add(0,r,ri);
5316: }
5317: return ndtondv(0,r);
5318: }
5319:
5320: ND ptond(VL vl,VL dvl,P p)
5321: {
5322: int n,i,j,k,e;
5323: VL tvl;
5324: V v;
5325: DCP dc;
5326: DCP *w;
5327: ND r,s,t,u;
5328: P x;
5329: int c;
5330: UINT *d;
5331: NM m,m0;
5332:
5333: if ( !p )
5334: return 0;
5335: else if ( NUM(p) ) {
5336: NEWNM(m);
5337: ndl_zero(DL(m));
5338: if ( !INT((Q)p) )
5339: error("ptond : input must be integer-coefficient");
1.6 noro 5340: CZ(m) = (Z)p;
1.1 noro 5341: NEXT(m) = 0;
5342: MKND(nd_nvar,m,1,r);
5343: SG(r) = 0;
5344: return r;
5345: } else {
5346: for ( dc = DC(p), k = 0; dc; dc = NEXT(dc), k++ );
5347: w = (DCP *)MALLOC(k*sizeof(DCP));
5348: for ( dc = DC(p), j = 0; j < k; dc = NEXT(dc), j++ ) w[j] = dc;
5349: for ( i = 0, tvl = dvl, v = VR(p);
5350: tvl && tvl->v != v; tvl = NEXT(tvl), i++ );
5351: if ( !tvl ) {
5352: for ( j = k-1, s = 0, MKV(v,x); j >= 0; j-- ) {
5353: t = ptond(vl,dvl,COEF(w[j]));
5354: pwrp(vl,x,DEG(w[j]),&p);
5355: nd_mul_c_p(CO,t,p); s = nd_add(0,s,t);
5356: }
5357: return s;
5358: } else {
5359: NEWNM(m0); d = DL(m0);
5360: for ( j = k-1, s = 0; j >= 0; j-- ) {
1.6 noro 5361: ndl_zero(d); e = ZTOS(DEG(w[j])); PUT_EXP(d,i,e);
1.1 noro 5362: TD(d) = MUL_WEIGHT(e,i);
5363: if ( nd_blockmask) ndl_weight_mask(d);
5364: if ( nd_module ) MPOS(d) = 0;
5365: t = ptond(vl,dvl,COEF(w[j]));
5366: for ( m = BDY(t); m; m = NEXT(m) )
5367: ndl_addto(DL(m),d);
5368: SG(t) += TD(d);
5369: s = nd_add(0,s,t);
5370: }
5371: FREENM(m0);
5372: return s;
5373: }
5374: }
5375: }
5376:
5377: P ndvtop(int mod,VL vl,VL dvl,NDV p)
5378: {
5379: VL tvl;
5380: int len,n,j,i,e;
5381: NMV m;
5382: Z q;
5383: P c;
5384: UINT *d;
5385: P s,r,u,t,w;
5386: GFS gfs;
5387:
5388: if ( !p ) return 0;
5389: else {
5390: len = LEN(p);
5391: n = NV(p);
5392: m = (NMV)(((char *)BDY(p))+nmv_adv*(len-1));
5393: for ( j = len-1, s = 0; j >= 0; j--, NMV_PREV(m) ) {
5394: if ( mod == -1 ) {
5395: e = IFTOF(CM(m)); MKGFS(e,gfs); c = (P)gfs;
5396: } else if ( mod == -2 ) {
5397: c = (P)CZ(m);
5398: } else if ( mod > 0 ) {
1.6 noro 5399: STOZ(CM(m),q); c = (P)q;
1.1 noro 5400: } else
5401: c = CP(m);
5402: d = DL(m);
5403: for ( i = 0, t = c, tvl = dvl; i < n; tvl = NEXT(tvl), i++ ) {
1.6 noro 5404: MKV(tvl->v,r); e = GET_EXP(d,i); STOZ(e,q);
1.1 noro 5405: pwrp(vl,r,q,&u); mulp(vl,t,u,&w); t = w;
5406: }
5407: addp(vl,s,t,&u); s = u;
5408: }
5409: return s;
5410: }
5411: }
5412:
5413: LIST ndvtopl(int mod,VL vl,VL dvl,NDV p,int rank)
5414: {
5415: VL tvl;
5416: int len,n,j,i,e;
5417: NMV m;
5418: Z q;
5419: P c;
5420: UINT *d;
5421: P s,r,u,t,w;
5422: GFS gfs;
5423: P *a;
5424: LIST l;
5425: NODE nd,nd1;
5426:
5427: if ( !p ) return 0;
5428: else {
5429: a = (P *)MALLOC((rank+1)*sizeof(P));
5430: for ( i = 0; i <= rank; i++ ) a[i] = 0;
5431: len = LEN(p);
5432: n = NV(p);
5433: m = (NMV)(((char *)BDY(p))+nmv_adv*(len-1));
5434: for ( j = len-1; j >= 0; j--, NMV_PREV(m) ) {
5435: if ( mod == -1 ) {
5436: e = IFTOF(CM(m)); MKGFS(e,gfs); c = (P)gfs;
5437: } else if ( mod ) {
1.6 noro 5438: STOZ(CM(m),q); c = (P)q;
1.1 noro 5439: } else
5440: c = CP(m);
5441: d = DL(m);
5442: for ( i = 0, t = c, tvl = dvl; i < n; tvl = NEXT(tvl), i++ ) {
1.6 noro 5443: MKV(tvl->v,r); e = GET_EXP(d,i); STOZ(e,q);
1.1 noro 5444: pwrp(vl,r,q,&u); mulp(vl,t,u,&w); t = w;
5445: }
5446: addp(vl,a[MPOS(d)],t,&u); a[MPOS(d)] = u;
5447: }
5448: nd = 0;
5449: for ( i = rank; i > 0; i-- ) {
5450: MKNODE(nd1,a[i],nd); nd = nd1;
5451: }
5452: MKLIST(l,nd);
5453: return l;
5454: }
5455: }
5456:
5457: NDV ndtondv(int mod,ND p)
5458: {
5459: NDV d;
5460: NMV m,m0;
5461: NM t;
5462: int i,len;
5463:
5464: if ( !p ) return 0;
5465: len = LEN(p);
5466: if ( mod > 0 || mod == -1 )
5467: m0 = m = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(len*nmv_adv);
5468: else
5469: m0 = m = MALLOC(len*nmv_adv);
5470: #if 0
5471: ndv_alloc += nmv_adv*len;
5472: #endif
5473: for ( t = BDY(p), i = 0; t; t = NEXT(t), i++, NMV_ADV(m) ) {
5474: ndl_copy(DL(t),DL(m));
1.6 noro 5475: CZ(m) = CZ(t);
1.1 noro 5476: }
5477: MKNDV(NV(p),m0,len,d);
5478: SG(d) = SG(p);
5479: return d;
5480: }
5481:
1.16 noro 5482: static int dmm_comp_nv;
5483:
5484: int dmm_comp(DMM *a,DMM *b)
5485: {
5486: return -compdmm(dmm_comp_nv,*a,*b);
5487: }
5488:
5489: void dmm_sort_by_ord(DMM *a,int len,int nv)
5490: {
5491: dmm_comp_nv = nv;
5492: qsort(a,len,sizeof(DMM),(int (*)(const void *,const void *))dmm_comp);
5493: }
5494:
5495: void dpm_sort(DPM p,DPM *rp)
5496: {
5497: DMM t,t1;
5498: int len,i,n;
5499: DMM *a;
5500: DPM d;
5501:
5502: if ( !p ) *rp = 0;
5503: for ( t = BDY(p), len = 0; t; t = NEXT(t), len++ );
5504: a = (DMM *)MALLOC(len*sizeof(DMM));
5505: for ( i = 0, t = BDY(p); i < len; i++, t = NEXT(t) ) a[i] = t;
5506: n = p->nv;
5507: dmm_sort_by_ord(a,len,n);
5508: t = 0;
5509: for ( i = len-1; i >= 0; i-- ) {
5510: NEWDMM(t1);
5511: t1->c = a[i]->c;
5512: t1->dl = a[i]->dl;
5513: t1->pos = a[i]->pos;
5514: t1->next = t;
5515: t = t1;
5516: }
5517: MKDPM(n,t,d);
5518: SG(d) = SG(p);
5519: *rp = d;
5520: }
5521:
1.18 noro 5522: int dpm_comp(DPM *a,DPM *b)
5523: {
5524: return compdpm(CO,*a,*b);
5525: }
5526:
5527: NODE dpm_sort_list(NODE l)
5528: {
5529: int i,len;
5530: NODE t,t1;
5531: DPM *a;
5532:
5533: len = length(l);
5534: a = (DPM *)MALLOC(len*sizeof(DPM));
5535: for ( t = l, i = 0; i < len; i++, t = NEXT(t) ) a[i] = (DPM)BDY(t);
5536: qsort(a,len,sizeof(DPM),(int (*)(const void *,const void *))dpm_comp);
5537: t = 0;
5538: for ( i = len-1; i >= 0; i-- ) {
5539: MKNODE(t1,(pointer)a[i],t); t = t1;
5540: }
5541: return t;
5542: }
5543:
1.20 ! noro 5544: int nmv_comp(NMV a,NMV b)
! 5545: {
! 5546: return -DL_COMPARE(a->dl,b->dl);
! 5547: }
! 5548:
1.16 noro 5549: NDV dpmtondv(int mod,DPM p)
5550: {
5551: NDV d;
5552: NMV m,m0;
5553: DMM t;
5554: DMM *a;
5555: int i,len,n;
5556:
5557: if ( !p ) return 0;
5558: for ( t = BDY(p), len = 0; t; t = NEXT(t), len++ );
5559: a = (DMM *)MALLOC(len*sizeof(DMM));
5560: for ( i = 0, t = BDY(p); i < len; i++, t = NEXT(t) ) a[i] = t;
5561: n = p->nv;
5562: dmm_sort_by_ord(a,len,n);
5563: if ( mod > 0 || mod == -1 )
5564: m0 = m = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(len*nmv_adv);
5565: else
5566: m0 = m = MALLOC(len*nmv_adv);
5567: #if 0
5568: ndv_alloc += nmv_adv*len;
5569: #endif
5570: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5571: dltondl(n,a[i]->dl,DL(m));
5572: MPOS(DL(m)) = a[i]->pos;
1.20 ! noro 5573: TD(DL(m)) = ndl_weight(DL(m));
1.16 noro 5574: CZ(m) = (Z)a[i]->c;
5575: }
1.20 ! noro 5576: qsort(m0,len,nmv_adv,(int (*)(const void *,const void *))nmv_comp);
1.16 noro 5577: MKNDV(NV(p),m0,len,d);
5578: SG(d) = SG(p);
5579: return d;
5580: }
5581:
1.1 noro 5582: ND ndvtond(int mod,NDV p)
5583: {
5584: ND d;
5585: NM m,m0;
5586: NMV t;
5587: int i,len;
5588:
5589: if ( !p ) return 0;
5590: m0 = 0;
5591: len = p->len;
5592: for ( t = BDY(p), i = 0; i < len; NMV_ADV(t), i++ ) {
5593: NEXTNM(m0,m);
5594: ndl_copy(DL(t),DL(m));
1.6 noro 5595: CZ(m) = CZ(t);
1.1 noro 5596: }
5597: NEXT(m) = 0;
5598: MKND(NV(p),m0,len,d);
5599: SG(d) = SG(p);
5600: return d;
5601: }
5602:
5603: DP ndvtodp(int mod,NDV p)
5604: {
5605: MP m,m0;
5606: DP d;
5607: NMV t;
5608: int i,len;
5609:
5610: if ( !p ) return 0;
5611: m0 = 0;
5612: len = p->len;
5613: for ( t = BDY(p), i = 0; i < len; NMV_ADV(t), i++ ) {
5614: NEXTMP(m0,m);
5615: m->dl = ndltodl(nd_nvar,DL(t));
5616: m->c = (Obj)ndctop(mod,t->c);
5617: }
5618: NEXT(m) = 0;
5619: MKDP(nd_nvar,m0,d);
5620: SG(d) = SG(p);
5621: return d;
5622: }
5623:
1.16 noro 5624: DPM ndvtodpm(int mod,NDV p)
5625: {
5626: DMM m,m0;
5627: DPM d;
5628: NMV t;
5629: int i,len;
5630:
5631: if ( !p ) return 0;
5632: m0 = 0;
5633: len = p->len;
5634: for ( t = BDY(p), i = 0; i < len; NMV_ADV(t), i++ ) {
5635: NEXTDMM(m0,m);
5636: m->dl = ndltodl(nd_nvar,DL(t));
5637: m->c = (Obj)ndctop(mod,t->c);
5638: m->pos = MPOS(DL(t));
5639: }
5640: NEXT(m) = 0;
5641: MKDPM(nd_nvar,m0,d);
5642: SG(d) = SG(p);
5643: return d;
5644: }
5645:
5646:
1.1 noro 5647: DP ndtodp(int mod,ND p)
5648: {
5649: MP m,m0;
5650: DP d;
5651: NM t;
5652: int i,len;
5653:
5654: if ( !p ) return 0;
5655: m0 = 0;
5656: len = p->len;
5657: for ( t = BDY(p); t; t = NEXT(t) ) {
5658: NEXTMP(m0,m);
5659: m->dl = ndltodl(nd_nvar,DL(t));
5660: m->c = (Obj)ndctop(mod,t->c);
5661: }
5662: NEXT(m) = 0;
5663: MKDP(nd_nvar,m0,d);
5664: SG(d) = SG(p);
5665: return d;
5666: }
5667:
5668: void ndv_print(NDV p)
5669: {
5670: NMV m;
5671: int i,len;
5672:
5673: if ( !p ) printf("0\n");
5674: else {
5675: len = LEN(p);
5676: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
5677: if ( CM(m) & 0x80000000 ) printf("+@_%d*",IFTOF(CM(m)));
5678: else printf("+%d*",CM(m));
5679: ndl_print(DL(m));
5680: }
5681: printf("\n");
5682: }
5683: }
5684:
5685: void ndv_print_q(NDV p)
5686: {
5687: NMV m;
5688: int i,len;
5689:
5690: if ( !p ) printf("0\n");
5691: else {
5692: len = LEN(p);
5693: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
5694: printf("+");
1.6 noro 5695: printexpr(CO,(Obj)CZ(m));
1.1 noro 5696: printf("*");
5697: ndl_print(DL(m));
5698: }
5699: printf("\n");
5700: }
5701: }
5702:
5703: NODE ndv_reducebase(NODE x,int *perm)
5704: {
5705: int len,i,j;
5706: NDVI w;
5707: NODE t,t0;
5708:
5709: len = length(x);
5710: w = (NDVI)MALLOC(len*sizeof(struct oNDVI));
5711: for ( i = 0, t = x; i < len; i++, t = NEXT(t) ) {
5712: w[i].p = BDY(t); w[i].i = perm[i];
5713: }
5714: for ( i = 0; i < len; i++ ) {
5715: for ( j = 0; j < i; j++ ) {
5716: if ( w[i].p && w[j].p ) {
5717: if ( ndl_reducible(HDL(w[i].p),HDL(w[j].p)) ) w[i].p = 0;
5718: else if ( ndl_reducible(HDL(w[j].p),HDL(w[i].p)) ) w[j].p = 0;
5719: }
5720: }
5721: }
5722: for ( i = j = 0, t0 = 0; i < len; i++ ) {
5723: if ( w[i].p ) {
5724: NEXTNODE(t0,t); BDY(t) = (pointer)w[i].p;
5725: perm[j++] = w[i].i;
5726: }
5727: }
5728: NEXT(t) = 0; x = t0;
5729: return x;
5730: }
5731:
5732: /* XXX incomplete */
5733:
1.16 noro 5734: extern int dpm_ordtype;
5735:
1.1 noro 5736: void nd_init_ord(struct order_spec *ord)
5737: {
5738: nd_module = (ord->id >= 256);
5739: if ( nd_module ) {
5740: nd_dcomp = -1;
5741: nd_ispot = ord->ispot;
5742: nd_pot_nelim = ord->pot_nelim;
5743: nd_poly_weight_len = ord->nv;
5744: nd_poly_weight = ord->top_weight;
5745: nd_module_rank = ord->module_rank;
5746: nd_module_weight = ord->module_top_weight;
1.16 noro 5747: dpm_ordtype = ord->ispot;
1.1 noro 5748: }
5749: nd_matrix = 0;
5750: nd_matrix_len = 0;
5751: switch ( ord->id ) {
5752: case 0:
5753: switch ( ord->ord.simple ) {
5754: case 0:
5755: nd_dcomp = 1;
5756: nd_isrlex = 1;
5757: break;
5758: case 1:
5759: nd_dcomp = 1;
5760: nd_isrlex = 0;
5761: break;
5762: case 2:
5763: nd_dcomp = 0;
5764: nd_isrlex = 0;
5765: ndl_compare_function = ndl_lex_compare;
5766: break;
5767: case 11:
5768: /* XXX */
5769: nd_dcomp = 0;
5770: nd_isrlex = 1;
5771: ndl_compare_function = ndl_ww_lex_compare;
5772: break;
5773: default:
5774: error("nd_gr : unsupported order");
5775: }
5776: break;
5777: case 1:
5778: /* block order */
5779: /* XXX */
5780: nd_dcomp = -1;
5781: nd_isrlex = 0;
5782: ndl_compare_function = ndl_block_compare;
5783: break;
5784: case 2:
5785: /* matrix order */
5786: /* XXX */
5787: nd_dcomp = -1;
5788: nd_isrlex = 0;
5789: nd_matrix_len = ord->ord.matrix.row;
5790: nd_matrix = ord->ord.matrix.matrix;
5791: ndl_compare_function = ndl_matrix_compare;
5792: break;
5793: case 3:
5794: /* composite order */
5795: nd_dcomp = -1;
5796: nd_isrlex = 0;
5797: nd_worb_len = ord->ord.composite.length;
5798: nd_worb = ord->ord.composite.w_or_b;
5799: ndl_compare_function = ndl_composite_compare;
5800: break;
5801:
5802: /* module order */
5803: case 256:
5804: switch ( ord->ord.simple ) {
5805: case 0:
5806: nd_isrlex = 1;
5807: ndl_compare_function = ndl_module_grlex_compare;
5808: break;
5809: case 1:
5810: nd_isrlex = 0;
5811: ndl_compare_function = ndl_module_glex_compare;
5812: break;
5813: case 2:
5814: nd_isrlex = 0;
5815: ndl_compare_function = ndl_module_lex_compare;
5816: break;
5817: default:
5818: error("nd_gr : unsupported order");
5819: }
5820: break;
5821: case 257:
5822: /* block order */
5823: nd_isrlex = 0;
5824: ndl_compare_function = ndl_module_block_compare;
5825: break;
5826: case 258:
5827: /* matrix order */
5828: nd_isrlex = 0;
5829: nd_matrix_len = ord->ord.matrix.row;
5830: nd_matrix = ord->ord.matrix.matrix;
5831: ndl_compare_function = ndl_module_matrix_compare;
5832: break;
5833: case 259:
5834: /* composite order */
5835: nd_isrlex = 0;
5836: nd_worb_len = ord->ord.composite.length;
5837: nd_worb = ord->ord.composite.w_or_b;
5838: ndl_compare_function = ndl_module_composite_compare;
5839: break;
5840: }
5841: nd_ord = ord;
5842: }
5843:
5844: BlockMask nd_create_blockmask(struct order_spec *ord)
5845: {
5846: int n,i,j,s,l;
5847: UINT *t;
5848: BlockMask bm;
5849:
5850: /* we only create mask table for block order */
5851: if ( ord->id != 1 && ord->id != 257 )
5852: return 0;
5853: n = ord->ord.block.length;
5854: bm = (BlockMask)MALLOC(sizeof(struct oBlockMask));
5855: bm->n = n;
5856: bm->order_pair = ord->ord.block.order_pair;
5857: bm->mask = (UINT **)MALLOC(n*sizeof(UINT *));
5858: for ( i = 0, s = 0; i < n; i++ ) {
5859: bm->mask[i] = t = (UINT *)MALLOC_ATOMIC(nd_wpd*sizeof(UINT));
5860: for ( j = 0; j < nd_wpd; j++ ) t[j] = 0;
5861: l = bm->order_pair[i].length;
5862: for ( j = 0; j < l; j++, s++ ) PUT_EXP(t,s,nd_mask0);
5863: }
5864: return bm;
5865: }
5866:
5867: EPOS nd_create_epos(struct order_spec *ord)
5868: {
5869: int i,j,l,s,ord_l,ord_o;
5870: EPOS epos;
5871: struct order_pair *op;
5872:
5873: epos = (EPOS)MALLOC_ATOMIC(nd_nvar*sizeof(struct oEPOS));
5874: switch ( ord->id ) {
5875: case 0: case 256:
5876: if ( nd_isrlex ) {
5877: for ( i = 0; i < nd_nvar; i++ ) {
5878: epos[i].i = nd_exporigin + (nd_nvar-1-i)/nd_epw;
5879: epos[i].s = (nd_epw-((nd_nvar-1-i)%nd_epw)-1)*nd_bpe;
5880: }
5881: } else {
5882: for ( i = 0; i < nd_nvar; i++ ) {
5883: epos[i].i = nd_exporigin + i/nd_epw;
5884: epos[i].s = (nd_epw-(i%nd_epw)-1)*nd_bpe;
5885: }
5886: }
5887: break;
5888: case 1: case 257:
5889: /* block order */
5890: l = ord->ord.block.length;
5891: op = ord->ord.block.order_pair;
5892: for ( j = 0, s = 0; j < l; j++ ) {
5893: ord_o = op[j].order;
5894: ord_l = op[j].length;
5895: if ( !ord_o )
5896: for ( i = 0; i < ord_l; i++ ) {
5897: epos[s+i].i = nd_exporigin + (s+ord_l-i-1)/nd_epw;
5898: epos[s+i].s = (nd_epw-((s+ord_l-i-1)%nd_epw)-1)*nd_bpe;
5899: }
5900: else
5901: for ( i = 0; i < ord_l; i++ ) {
5902: epos[s+i].i = nd_exporigin + (s+i)/nd_epw;
5903: epos[s+i].s = (nd_epw-((s+i)%nd_epw)-1)*nd_bpe;
5904: }
5905: s += ord_l;
5906: }
5907: break;
5908: case 2:
5909: /* matrix order */
5910: case 3:
5911: /* composite order */
5912: default:
5913: for ( i = 0; i < nd_nvar; i++ ) {
5914: epos[i].i = nd_exporigin + i/nd_epw;
5915: epos[i].s = (nd_epw-(i%nd_epw)-1)*nd_bpe;
5916: }
5917: break;
5918: }
5919: return epos;
5920: }
5921:
5922: /* external interface */
5923:
5924: void nd_nf_p(Obj f,LIST g,LIST v,int m,struct order_spec *ord,Obj *rp)
5925: {
5926: NODE t,in0,in;
5927: ND ndf,nf;
5928: NDV ndvf;
5929: VL vv,tv;
5930: int stat,nvar,max,mrank;
5931: union oNDC dn;
5932: Q cont;
5933: P pp;
5934: LIST ppl;
5935:
5936: if ( !f ) {
5937: *rp = 0;
5938: return;
5939: }
5940: pltovl(v,&vv);
5941: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
5942:
5943: /* max=65536 implies nd_bpe=32 */
5944: max = 65536;
5945:
5946: nd_module = 0;
5947: /* nd_module will be set if ord is a module ordering */
5948: nd_init_ord(ord);
5949: nd_setup_parameters(nvar,max);
5950: if ( nd_module && OID(f) != O_LIST )
5951: error("nd_nf_p : the first argument must be a list");
5952: if ( nd_module ) mrank = length(BDY((LIST)f));
5953: /* conversion to ndv */
5954: for ( in0 = 0, t = BDY(g); t; t = NEXT(t) ) {
5955: NEXTNODE(in0,in);
5956: if ( nd_module ) {
5957: if ( !BDY(t) || OID(BDY(t)) != O_LIST
5958: || length(BDY((LIST)BDY(t))) != mrank )
5959: error("nd_nf_p : inconsistent basis element");
5960: if ( !m ) pltozpl((LIST)BDY(t),&cont,&ppl);
5961: else ppl = (LIST)BDY(t);
5962: BDY(in) = (pointer)pltondv(CO,vv,ppl);
5963: } else {
5964: if ( !m ) ptozp((P)BDY(t),1,&cont,&pp);
5965: else pp = (P)BDY(t);
5966: BDY(in) = (pointer)ptondv(CO,vv,pp);
5967: }
5968: if ( m ) ndv_mod(m,(NDV)BDY(in));
5969: }
5970: if ( in0 ) NEXT(in) = 0;
5971:
5972: if ( nd_module ) ndvf = pltondv(CO,vv,(LIST)f);
5973: else ndvf = ptondv(CO,vv,(P)f);
5974: if ( m ) ndv_mod(m,ndvf);
5975: ndf = (pointer)ndvtond(m,ndvf);
5976:
5977: /* dont sort, dont removecont */
5978: ndv_setup(m,0,in0,1,1);
5979: nd_scale=2;
1.6 noro 5980: stat = nd_nf(m,0,ndf,nd_ps,1,&nf);
1.1 noro 5981: if ( !stat )
5982: error("nd_nf_p : exponent too large");
5983: if ( nd_module ) *rp = (Obj)ndvtopl(m,CO,vv,ndtondv(m,nf),mrank);
5984: else *rp = (Obj)ndvtop(m,CO,vv,ndtondv(m,nf));
5985: }
5986:
5987: int nd_to_vect(int mod,UINT *s0,int n,ND d,UINT *r)
5988: {
5989: NM m;
5990: UINT *t,*s;
5991: int i;
5992:
5993: for ( i = 0; i < n; i++ ) r[i] = 0;
5994: for ( i = 0, s = s0, m = BDY(d); m; m = NEXT(m) ) {
5995: t = DL(m);
5996: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
5997: r[i] = CM(m);
5998: }
5999: for ( i = 0; !r[i]; i++ );
6000: return i;
6001: }
6002:
6003: int nd_to_vect_q(UINT *s0,int n,ND d,Z *r)
6004: {
6005: NM m;
6006: UINT *t,*s;
6007: int i;
6008:
6009: for ( i = 0; i < n; i++ ) r[i] = 0;
6010: for ( i = 0, s = s0, m = BDY(d); m; m = NEXT(m) ) {
6011: t = DL(m);
6012: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
1.6 noro 6013: r[i] = CZ(m);
1.1 noro 6014: }
6015: for ( i = 0; !r[i]; i++ );
6016: return i;
6017: }
6018:
6019: int nd_to_vect_lf(UINT *s0,int n,ND d,mpz_t *r)
6020: {
6021: NM m;
6022: UINT *t,*s;
6023: int i;
6024:
6025: for ( i = 0; i < n; i++ ) { mpz_init(r[i]); mpz_set_ui(r[i],0); }
6026: for ( i = 0, s = s0, m = BDY(d); m; m = NEXT(m) ) {
6027: t = DL(m);
6028: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
6029: mpz_set(r[i],BDY(CZ(m)));
6030: }
6031: for ( i = 0; !mpz_sgn(r[i]); i++ );
6032: return i;
6033: }
6034:
6035: unsigned long *nd_to_vect_2(UINT *s0,int n,int *s0hash,ND p)
6036: {
6037: NM m;
6038: unsigned long *v;
6039: int i,j,h,size;
6040: UINT *s,*t;
6041:
6042: size = sizeof(unsigned long)*(n+BLEN-1)/BLEN;
6043: v = (unsigned long *)MALLOC_ATOMIC_IGNORE_OFF_PAGE(size);
6044: bzero(v,size);
6045: for ( i = j = 0, s = s0, m = BDY(p); m; j++, m = NEXT(m) ) {
6046: t = DL(m);
6047: h = ndl_hash_value(t);
6048: for ( ; h != s0hash[i] || !ndl_equal(t,s); s += nd_wpd, i++ );
6049: v[i/BLEN] |= 1L <<(i%BLEN);
6050: }
6051: return v;
6052: }
6053:
6054: int nd_nm_to_vect_2(UINT *s0,int n,int *s0hash,NDV p,NM m,unsigned long *v)
6055: {
6056: NMV mr;
6057: UINT *d,*t,*s;
6058: int i,j,len,h,head;
6059:
6060: d = DL(m);
6061: len = LEN(p);
6062: t = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
6063: for ( i = j = 0, s = s0, mr = BDY(p); j < len; j++, NMV_ADV(mr) ) {
6064: ndl_add(d,DL(mr),t);
6065: h = ndl_hash_value(t);
6066: for ( ; h != s0hash[i] || !ndl_equal(t,s); s += nd_wpd, i++ );
6067: if ( j == 0 ) head = i;
6068: v[i/BLEN] |= 1L <<(i%BLEN);
6069: }
6070: return head;
6071: }
6072:
6073: Z *nm_ind_pair_to_vect(int mod,UINT *s0,int n,NM_ind_pair pair)
6074: {
6075: NM m;
6076: NMV mr;
6077: UINT *d,*t,*s;
6078: NDV p;
6079: int i,j,len;
6080: Z *r;
6081:
6082: m = pair->mul;
6083: d = DL(m);
6084: p = nd_ps[pair->index];
6085: len = LEN(p);
6086: r = (Z *)CALLOC(n,sizeof(Q));
6087: t = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
6088: for ( i = j = 0, s = s0, mr = BDY(p); j < len; j++, NMV_ADV(mr) ) {
6089: ndl_add(d,DL(mr),t);
6090: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
1.6 noro 6091: r[i] = CZ(mr);
1.1 noro 6092: }
6093: return r;
6094: }
6095:
1.11 noro 6096: IndArray nm_ind_pair_to_vect_compress(int trace,UINT *s0,int n,NM_ind_pair pair,int start)
1.1 noro 6097: {
6098: NM m;
6099: NMV mr;
1.11 noro 6100: UINT *d,*t,*s,*u;
1.1 noro 6101: NDV p;
6102: unsigned char *ivc;
6103: unsigned short *ivs;
6104: UINT *v,*ivi,*s0v;
1.11 noro 6105: int i,j,len,prev,diff,cdiff,h,st,ed,md,c;
1.1 noro 6106: IndArray r;
6107:
6108: m = pair->mul;
6109: d = DL(m);
6110: if ( trace )
6111: p = nd_demand?nd_ps_trace_sym[pair->index]:nd_ps_trace[pair->index];
6112: else
6113: p = nd_demand?nd_ps_sym[pair->index]:nd_ps[pair->index];
6114:
6115: len = LEN(p);
6116: t = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
6117: v = (unsigned int *)MALLOC(len*sizeof(unsigned int));
1.11 noro 6118: for ( prev = start, mr = BDY(p), j = 0; j < len; j++, NMV_ADV(mr) ) {
6119: ndl_add(d,DL(mr),t);
6120: st = prev;
6121: ed = n;
6122: while ( ed > st ) {
6123: md = (st+ed)/2;
6124: u = s0+md*nd_wpd;
6125: c = DL_COMPARE(u,t);
6126: if ( c == 0 ) break;
6127: else if ( c > 0 ) st = md;
6128: else ed = md;
6129: }
6130: prev = v[j] = md;
1.1 noro 6131: }
6132: r = (IndArray)MALLOC(sizeof(struct oIndArray));
6133: r->head = v[0];
6134: diff = 0;
6135: for ( i = 1; i < len; i++ ) {
6136: cdiff = v[i]-v[i-1]; diff = MAX(cdiff,diff);
6137: }
6138: if ( diff < 256 ) {
6139: r->width = 1;
6140: ivc = (unsigned char *)MALLOC_ATOMIC(len*sizeof(unsigned char));
6141: r->index.c = ivc;
6142: for ( i = 1, ivc[0] = 0; i < len; i++ ) ivc[i] = v[i]-v[i-1];
6143: } else if ( diff < 65536 ) {
6144: r->width = 2;
6145: ivs = (unsigned short *)MALLOC_ATOMIC(len*sizeof(unsigned short));
6146: r->index.s = ivs;
6147: for ( i = 1, ivs[0] = 0; i < len; i++ ) ivs[i] = v[i]-v[i-1];
6148: } else {
6149: r->width = 4;
6150: ivi = (unsigned int *)MALLOC_ATOMIC(len*sizeof(unsigned int));
6151: r->index.i = ivi;
6152: for ( i = 1, ivi[0] = 0; i < len; i++ ) ivi[i] = v[i]-v[i-1];
6153: }
6154: return r;
6155: }
6156:
6157: int compress_array(Z *svect,Z *cvect,int n)
6158: {
6159: int i,j;
6160:
6161: for ( i = j = 0; i < n; i++ )
6162: if ( svect[i] ) cvect[j++] = svect[i];
6163: return j;
6164: }
6165:
6166: void expand_array(Z *svect,Z *cvect,int n)
6167: {
6168: int i,j;
6169:
6170: for ( i = j = 0; j < n; i++ )
6171: if ( svect[i] ) svect[i] = cvect[j++];
6172: }
6173:
1.8 noro 6174: #if 0
1.1 noro 6175: int ndv_reduce_vect_q(Z *svect,int trace,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
6176: {
6177: int i,j,k,len,pos,prev,nz;
6178: Z cs,mcs,c1,c2,cr,gcd,t;
6179: IndArray ivect;
6180: unsigned char *ivc;
6181: unsigned short *ivs;
6182: unsigned int *ivi;
6183: NDV redv;
6184: NMV mr;
6185: NODE rp;
6186: int maxrs;
6187: double hmag;
6188: Z *cvect;
1.3 noro 6189: int l;
1.1 noro 6190:
6191: maxrs = 0;
6192: for ( i = 0; i < col && !svect[i]; i++ );
6193: if ( i == col ) return maxrs;
6194: hmag = p_mag((P)svect[i])*nd_scale;
6195: cvect = (Z *)MALLOC(col*sizeof(Q));
6196: for ( i = 0; i < nred; i++ ) {
6197: ivect = imat[i];
6198: k = ivect->head;
6199: if ( svect[k] ) {
6200: maxrs = MAX(maxrs,rp0[i]->sugar);
6201: redv = nd_demand?ndv_load(rp0[i]->index)
6202: :(trace?nd_ps_trace[rp0[i]->index]:nd_ps[rp0[i]->index]);
6203: len = LEN(redv); mr = BDY(redv);
1.6 noro 6204: igcd_cofactor(svect[k],CZ(mr),&gcd,&cs,&cr);
1.1 noro 6205: chsgnz(cs,&mcs);
6206: if ( !UNIQ(cr) ) {
6207: for ( j = 0; j < col; j++ ) {
6208: mulz(svect[j],cr,&c1); svect[j] = c1;
6209: }
6210: }
6211: svect[k] = 0; prev = k;
6212: switch ( ivect->width ) {
6213: case 1:
6214: ivc = ivect->index.c;
6215: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6216: pos = prev+ivc[j]; prev = pos;
1.6 noro 6217: muladdtoz(CZ(mr),mcs,&svect[pos]);
1.1 noro 6218: }
6219: break;
6220: case 2:
6221: ivs = ivect->index.s;
6222: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6223: pos = prev+ivs[j]; prev = pos;
1.6 noro 6224: muladdtoz(CZ(mr),mcs,&svect[pos]);
1.1 noro 6225: }
6226: break;
6227: case 4:
6228: ivi = ivect->index.i;
6229: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6230: pos = prev+ivi[j]; prev = pos;
1.6 noro 6231: muladdtoz(CZ(mr),mcs,&svect[pos]);
1.1 noro 6232: }
6233: break;
6234: }
6235: for ( j = k+1; j < col && !svect[j]; j++ );
6236: if ( j == col ) break;
6237: if ( hmag && ((double)p_mag((P)svect[j]) > hmag) ) {
6238: nz = compress_array(svect,cvect,col);
6239: removecont_array((P *)cvect,nz,1);
6240: expand_array(svect,cvect,nz);
6241: hmag = ((double)p_mag((P)svect[j]))*nd_scale;
6242: }
6243: }
6244: }
6245: nz = compress_array(svect,cvect,col);
6246: removecont_array((P *)cvect,nz,1);
6247: expand_array(svect,cvect,nz);
6248: if ( DP_Print ) {
6249: fprintf(asir_out,"-"); fflush(asir_out);
6250: }
6251: return maxrs;
6252: }
1.4 noro 6253: #else
1.9 noro 6254:
1.4 noro 6255: /* direct mpz version */
6256: int ndv_reduce_vect_q(Z *svect0,int trace,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
6257: {
6258: int i,j,k,len,pos,prev;
6259: mpz_t cs,cr,gcd;
6260: IndArray ivect;
6261: unsigned char *ivc;
6262: unsigned short *ivs;
6263: unsigned int *ivi;
6264: NDV redv;
6265: NMV mr;
6266: NODE rp;
6267: int maxrs;
6268: double hmag;
6269: int l;
1.13 noro 6270: static mpz_t *svect;
6271: static int svect_len=0;
1.4 noro 6272:
6273: maxrs = 0;
6274: for ( i = 0; i < col && !svect0[i]; i++ );
6275: if ( i == col ) return maxrs;
6276: hmag = p_mag((P)svect0[i])*nd_scale;
1.13 noro 6277: if ( col > svect_len ) {
6278: svect = (mpz_t *)MALLOC(col*sizeof(mpz_t));
6279: svect_len = col;
6280: }
1.4 noro 6281: for ( i = 0; i < col; i++ ) {
6282: mpz_init(svect[i]);
6283: if ( svect0[i] )
6284: mpz_set(svect[i],BDY(svect0[i]));
6285: else
6286: mpz_set_ui(svect[i],0);
6287: }
6288: mpz_init(gcd); mpz_init(cs); mpz_init(cr);
6289: for ( i = 0; i < nred; i++ ) {
6290: ivect = imat[i];
6291: k = ivect->head;
6292: if ( mpz_sgn(svect[k]) ) {
6293: maxrs = MAX(maxrs,rp0[i]->sugar);
6294: redv = nd_demand?ndv_load(rp0[i]->index)
6295: :(trace?nd_ps_trace[rp0[i]->index]:nd_ps[rp0[i]->index]);
6296: len = LEN(redv); mr = BDY(redv);
1.6 noro 6297: mpz_gcd(gcd,svect[k],BDY(CZ(mr)));
1.4 noro 6298: mpz_div(cs,svect[k],gcd);
1.6 noro 6299: mpz_div(cr,BDY(CZ(mr)),gcd);
1.4 noro 6300: mpz_neg(cs,cs);
1.9 noro 6301: if ( MUNIMPZ(cr) )
6302: for ( j = 0; j < col; j++ ) mpz_neg(svect[j],svect[j]);
6303: else if ( !UNIMPZ(cr) )
6304: for ( j = 0; j < col; j++ ) {
6305: if ( mpz_sgn(svect[j]) ) mpz_mul(svect[j],svect[j],cr);
6306: }
1.4 noro 6307: mpz_set_ui(svect[k],0);
6308: prev = k;
6309: switch ( ivect->width ) {
6310: case 1:
6311: ivc = ivect->index.c;
6312: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6313: pos = prev+ivc[j]; prev = pos;
1.6 noro 6314: mpz_addmul(svect[pos],BDY(CZ(mr)),cs);
1.4 noro 6315: }
6316: break;
6317: case 2:
6318: ivs = ivect->index.s;
6319: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6320: pos = prev+ivs[j]; prev = pos;
1.6 noro 6321: mpz_addmul(svect[pos],BDY(CZ(mr)),cs);
1.4 noro 6322: }
6323: break;
6324: case 4:
6325: ivi = ivect->index.i;
6326: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6327: pos = prev+ivi[j]; prev = pos;
1.6 noro 6328: mpz_addmul(svect[pos],BDY(CZ(mr)),cs);
1.4 noro 6329: }
6330: break;
6331: }
6332: for ( j = k+1; j < col && !svect[j]; j++ );
6333: if ( j == col ) break;
6334: if ( hmag && ((double)mpz_sizeinbase(svect[j],2) > hmag) ) {
6335: mpz_removecont_array(svect,col);
6336: hmag = ((double)mpz_sizeinbase(svect[j],2))*nd_scale;
6337: }
6338: }
6339: }
6340: mpz_removecont_array(svect,col);
6341: if ( DP_Print ) {
6342: fprintf(asir_out,"-"); fflush(asir_out);
6343: }
6344: for ( i = 0; i < col; i++ )
6345: if ( mpz_sgn(svect[i]) ) MPZTOZ(svect[i],svect0[i]);
6346: else svect0[i] = 0;
6347: return maxrs;
6348: }
6349: #endif
1.1 noro 6350:
6351: int ndv_reduce_vect(int m,UINT *svect,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
6352: {
6353: int i,j,k,len,pos,prev;
6354: UINT c,c1,c2,c3,up,lo,dmy;
6355: IndArray ivect;
6356: unsigned char *ivc;
6357: unsigned short *ivs;
6358: unsigned int *ivi;
6359: NDV redv;
6360: NMV mr;
6361: NODE rp;
6362: int maxrs;
6363:
6364: maxrs = 0;
6365: for ( i = 0; i < nred; i++ ) {
6366: ivect = imat[i];
6367: k = ivect->head; svect[k] %= m;
6368: if ( (c = svect[k]) != 0 ) {
6369: maxrs = MAX(maxrs,rp0[i]->sugar);
6370: c = m-c; redv = nd_ps[rp0[i]->index];
6371: len = LEN(redv); mr = BDY(redv);
6372: svect[k] = 0; prev = k;
6373: switch ( ivect->width ) {
6374: case 1:
6375: ivc = ivect->index.c;
6376: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6377: pos = prev+ivc[j]; c1 = CM(mr); prev = pos;
6378: if ( c1 ) {
6379: c2 = svect[pos];
6380: DMA(c1,c,c2,up,lo);
6381: if ( up ) { DSAB(m,up,lo,dmy,c3); svect[pos] = c3;
6382: } else svect[pos] = lo;
6383: }
6384: }
6385: break;
6386: case 2:
6387: ivs = ivect->index.s;
6388: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6389: pos = prev+ivs[j]; c1 = CM(mr);
6390: prev = pos;
6391: if ( c1 ) {
6392: c2 = svect[pos];
6393: DMA(c1,c,c2,up,lo);
6394: if ( up ) { DSAB(m,up,lo,dmy,c3); svect[pos] = c3;
6395: } else svect[pos] = lo;
6396: }
6397: }
6398: break;
6399: case 4:
6400: ivi = ivect->index.i;
6401: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6402: pos = prev+ivi[j]; c1 = CM(mr);
6403: prev = pos;
6404: if ( c1 ) {
6405: c2 = svect[pos];
6406: DMA(c1,c,c2,up,lo);
6407: if ( up ) { DSAB(m,up,lo,dmy,c3); svect[pos] = c3;
6408: } else svect[pos] = lo;
6409: }
6410: }
6411: break;
6412: }
6413: }
6414: }
6415: for ( i = 0; i < col; i++ )
6416: if ( svect[i] >= (UINT)m ) svect[i] %= m;
6417: return maxrs;
6418: }
6419:
6420: int ndv_reduce_vect_sf(int m,UINT *svect,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
6421: {
6422: int i,j,k,len,pos,prev;
6423: UINT c,c1,c2,c3,up,lo,dmy;
6424: IndArray ivect;
6425: unsigned char *ivc;
6426: unsigned short *ivs;
6427: unsigned int *ivi;
6428: NDV redv;
6429: NMV mr;
6430: NODE rp;
6431: int maxrs;
6432:
6433: maxrs = 0;
6434: for ( i = 0; i < nred; i++ ) {
6435: ivect = imat[i];
6436: k = ivect->head;
6437: if ( (c = svect[k]) != 0 ) {
6438: maxrs = MAX(maxrs,rp0[i]->sugar);
6439: c = _chsgnsf(c); redv = nd_ps[rp0[i]->index];
6440: len = LEN(redv); mr = BDY(redv);
6441: svect[k] = 0; prev = k;
6442: switch ( ivect->width ) {
6443: case 1:
6444: ivc = ivect->index.c;
6445: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6446: pos = prev+ivc[j]; prev = pos;
6447: svect[pos] = _addsf(_mulsf(CM(mr),c),svect[pos]);
6448: }
6449: break;
6450: case 2:
6451: ivs = ivect->index.s;
6452: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6453: pos = prev+ivs[j]; prev = pos;
6454: svect[pos] = _addsf(_mulsf(CM(mr),c),svect[pos]);
6455: }
6456: break;
6457: case 4:
6458: ivi = ivect->index.i;
6459: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6460: pos = prev+ivi[j]; prev = pos;
6461: svect[pos] = _addsf(_mulsf(CM(mr),c),svect[pos]);
6462: }
6463: break;
6464: }
6465: }
6466: }
6467: return maxrs;
6468: }
6469:
6470: ND nd_add_lf(ND p1,ND p2)
6471: {
6472: int n,c,can;
6473: ND r;
6474: NM m1,m2,mr0,mr,s;
6475: Z t;
6476:
6477: if ( !p1 ) return p2;
6478: else if ( !p2 ) return p1;
6479: else {
6480: can = 0;
6481: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
6482: c = DL_COMPARE(DL(m1),DL(m2));
6483: switch ( c ) {
6484: case 0:
6485: addlf(CZ(m1),CZ(m2),&t);
6486: s = m1; m1 = NEXT(m1);
6487: if ( t ) {
6488: can++; NEXTNM2(mr0,mr,s); CZ(mr) = (t);
6489: } else {
6490: can += 2; FREENM(s);
6491: }
6492: s = m2; m2 = NEXT(m2); FREENM(s);
6493: break;
6494: case 1:
6495: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
6496: break;
6497: case -1:
6498: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
6499: break;
6500: }
6501: }
6502: if ( !mr0 )
6503: if ( m1 ) mr0 = m1;
6504: else if ( m2 ) mr0 = m2;
6505: else return 0;
6506: else if ( m1 ) NEXT(mr) = m1;
6507: else if ( m2 ) NEXT(mr) = m2;
6508: else NEXT(mr) = 0;
6509: BDY(p1) = mr0;
6510: SG(p1) = MAX(SG(p1),SG(p2));
6511: LEN(p1) = LEN(p1)+LEN(p2)-can;
6512: FREEND(p2);
6513: return p1;
6514: }
6515: }
6516:
6517: int ndv_reduce_vect_lf(mpz_t *svect,int trace,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
6518: {
6519: int i,j,k,len,pos,prev;
6520: mpz_t c,mc,c1;
6521: IndArray ivect;
6522: unsigned char *ivc;
6523: unsigned short *ivs;
6524: unsigned int *ivi;
6525: NDV redv;
6526: NMV mr;
6527: NODE rp;
6528: int maxrs;
6529:
6530: maxrs = 0;
6531: lf_lazy = 1;
6532: for ( i = 0; i < nred; i++ ) {
6533: ivect = imat[i];
6534: k = ivect->head;
6535: mpz_mod(svect[k],svect[k],BDY(current_mod_lf));
6536: if ( mpz_sgn(svect[k]) ) {
6537: maxrs = MAX(maxrs,rp0[i]->sugar);
6538: mpz_neg(svect[k],svect[k]);
6539: redv = trace?nd_ps_trace[rp0[i]->index]:nd_ps[rp0[i]->index];
6540: len = LEN(redv); mr = BDY(redv);
6541: prev = k;
6542: switch ( ivect->width ) {
6543: case 1:
6544: ivc = ivect->index.c;
6545: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6546: pos = prev+ivc[j]; prev = pos;
6547: mpz_addmul(svect[pos],svect[k],BDY(CZ(mr)));
6548: }
6549: break;
6550: case 2:
6551: ivs = ivect->index.s;
6552: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6553: pos = prev+ivs[j]; prev = pos;
6554: mpz_addmul(svect[pos],svect[k],BDY(CZ(mr)));
6555: }
6556: break;
6557: case 4:
6558: ivi = ivect->index.i;
6559: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6560: pos = prev+ivi[j]; prev = pos;
6561: mpz_addmul(svect[pos],svect[k],BDY(CZ(mr)));
6562: }
6563: break;
6564: }
6565: mpz_set_ui(svect[k],0);
6566: }
6567: }
6568: lf_lazy=0;
6569: for ( i = 0; i < col; i++ ) {
6570: mpz_mod(svect[i],svect[i],BDY(current_mod_lf));
6571: }
6572: return maxrs;
6573: }
6574:
6575: int nd_gauss_elim_lf(mpz_t **mat0,int *sugar,int row,int col,int *colstat)
6576: {
6577: int i,j,k,l,rank,s;
6578: mpz_t a,a1,inv;
6579: mpz_t *t,*pivot,*pk;
6580: mpz_t **mat;
6581: struct oEGT eg0,eg1,eg_forward,eg_mod,eg_back;
6582: int size,size1;
6583:
6584: mpz_init(inv);
6585: mpz_init(a);
6586: mat = (mpz_t **)mat0;
6587: size = 0;
6588: for ( rank = 0, j = 0; j < col; j++ ) {
6589: for ( i = rank; i < row; i++ ) {
6590: mpz_mod(mat[i][j],mat[i][j],BDY(current_mod_lf));
6591: }
6592: for ( i = rank; i < row; i++ )
6593: if ( mpz_sgn(mat[i][j]) )
6594: break;
6595: if ( i == row ) {
6596: colstat[j] = 0;
6597: continue;
6598: } else
6599: colstat[j] = 1;
6600: if ( i != rank ) {
6601: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
6602: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
6603: }
6604: pivot = mat[rank];
6605: s = sugar[rank];
6606: mpz_invert(inv,pivot[j],BDY(current_mod_lf));
6607: for ( k = j, pk = pivot+k; k < col; k++, pk++ )
6608: if ( mpz_sgn(*pk) ) {
6609: mpz_mul(a,*pk,inv); mpz_mod(*pk,a,BDY(current_mod_lf));
6610: }
6611: for ( i = rank+1; i < row; i++ ) {
6612: t = mat[i];
6613: if ( mpz_sgn(t[j]) ) {
6614: sugar[i] = MAX(sugar[i],s);
6615: mpz_neg(a,t[j]);
6616: red_by_vect_lf(t+j,pivot+j,a,col-j);
6617: }
6618: }
6619: rank++;
6620: }
6621: for ( j = col-1, l = rank-1; j >= 0; j-- )
6622: if ( colstat[j] ) {
6623: pivot = mat[l];
6624: s = sugar[l];
6625: for ( k = j; k < col; k++ )
6626: mpz_mod(pivot[k],pivot[k],BDY(current_mod_lf));
6627: for ( i = 0; i < l; i++ ) {
6628: t = mat[i];
6629: if ( mpz_sgn(t[j]) ) {
6630: sugar[i] = MAX(sugar[i],s);
6631: mpz_neg(a,t[j]);
6632: red_by_vect_lf(t+j,pivot+j,a,col-j);
6633: }
6634: }
6635: l--;
6636: }
6637: for ( j = 0, l = 0; l < rank; j++ )
6638: if ( colstat[j] ) {
6639: t = mat[l];
6640: for ( k = j; k < col; k++ ) {
6641: mpz_mod(t[k],t[k],BDY(current_mod_lf));
6642: }
6643: l++;
6644: }
6645: return rank;
6646: }
6647:
6648:
6649: NDV vect_to_ndv(UINT *vect,int spcol,int col,int *rhead,UINT *s0vect)
6650: {
6651: int j,k,len;
6652: UINT *p;
6653: UINT c;
6654: NDV r;
6655: NMV mr0,mr;
6656:
6657: for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++;
6658: if ( !len ) return 0;
6659: else {
6660: mr0 = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
6661: #if 0
6662: ndv_alloc += nmv_adv*len;
6663: #endif
6664: mr = mr0;
6665: p = s0vect;
6666: for ( j = k = 0; j < col; j++, p += nd_wpd )
6667: if ( !rhead[j] ) {
6668: if ( (c = vect[k++]) != 0 ) {
6669: ndl_copy(p,DL(mr)); CM(mr) = c; NMV_ADV(mr);
6670: }
6671: }
6672: MKNDV(nd_nvar,mr0,len,r);
6673: return r;
6674: }
6675: }
6676:
6677: NDV vect_to_ndv_2(unsigned long *vect,int col,UINT *s0vect)
6678: {
6679: int j,k,len;
6680: UINT *p;
6681: NDV r;
6682: NMV mr0,mr;
6683:
6684: for ( j = 0, len = 0; j < col; j++ ) if ( vect[j/BLEN] & (1L<<(j%BLEN)) ) len++;
6685: if ( !len ) return 0;
6686: else {
6687: mr0 = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
6688: mr = mr0;
6689: p = s0vect;
6690: for ( j = 0; j < col; j++, p += nd_wpd )
6691: if ( vect[j/BLEN] & (1L<<(j%BLEN)) ) {
6692: ndl_copy(p,DL(mr)); CM(mr) = 1; NMV_ADV(mr);
6693: }
6694: MKNDV(nd_nvar,mr0,len,r);
6695: return r;
6696: }
6697: }
6698:
6699: /* for preprocessed vector */
6700:
6701: NDV vect_to_ndv_q(Z *vect,int spcol,int col,int *rhead,UINT *s0vect)
6702: {
1.6 noro 6703: int j,k,len;
6704: UINT *p;
6705: Z c;
6706: NDV r;
6707: NMV mr0,mr;
1.1 noro 6708:
1.6 noro 6709: for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++;
6710: if ( !len ) return 0;
6711: else {
6712: mr0 = (NMV)MALLOC(nmv_adv*len);
1.1 noro 6713: #if 0
1.6 noro 6714: ndv_alloc += nmv_adv*len;
1.1 noro 6715: #endif
1.6 noro 6716: mr = mr0;
6717: p = s0vect;
6718: for ( j = k = 0; j < col; j++, p += nd_wpd ) {
6719: if ( !rhead[j] ) {
6720: if ( (c = vect[k++]) != 0 ) {
6721: if ( !INT(c) )
6722: error("vect_to_ndv_q : components must be integers");
6723: ndl_copy(p,DL(mr)); CZ(mr) = c; NMV_ADV(mr);
6724: }
6725: }
1.1 noro 6726: }
1.6 noro 6727: MKNDV(nd_nvar,mr0,len,r);
6728: return r;
6729: }
1.1 noro 6730: }
6731:
6732: NDV vect_to_ndv_lf(mpz_t *vect,int spcol,int col,int *rhead,UINT *s0vect)
6733: {
6734: int j,k,len;
6735: UINT *p;
6736: mpz_t c;
6737: NDV r;
6738: NMV mr0,mr;
6739:
6740: for ( j = 0, len = 0; j < spcol; j++ ) if ( mpz_sgn(vect[j]) ) len++;
6741: if ( !len ) return 0;
6742: else {
6743: mr0 = (NMV)MALLOC(nmv_adv*len);
6744: #if 0
6745: ndv_alloc += nmv_adv*len;
6746: #endif
6747: mr = mr0;
6748: p = s0vect;
6749: for ( j = k = 0; j < col; j++, p += nd_wpd )
6750: if ( !rhead[j] ) {
6751: c[0] = vect[k++][0];
6752: if ( mpz_sgn(c) ) {
6753: ndl_copy(p,DL(mr)); MPZTOZ(c,CZ(mr)); NMV_ADV(mr);
6754: }
6755: }
6756: MKNDV(nd_nvar,mr0,len,r);
6757: return r;
6758: }
6759: }
6760:
6761: /* for plain vector */
6762:
6763: NDV plain_vect_to_ndv_q(Z *vect,int col,UINT *s0vect)
6764: {
6765: int j,k,len;
6766: UINT *p;
6767: Z c;
6768: NDV r;
6769: NMV mr0,mr;
6770:
6771: for ( j = 0, len = 0; j < col; j++ ) if ( vect[j] ) len++;
6772: if ( !len ) return 0;
6773: else {
6774: mr0 = (NMV)MALLOC(nmv_adv*len);
6775: #if 0
6776: ndv_alloc += nmv_adv*len;
6777: #endif
6778: mr = mr0;
6779: p = s0vect;
6780: for ( j = k = 0; j < col; j++, p += nd_wpd, k++ )
6781: if ( (c = vect[k]) != 0 ) {
6782: if ( !INT(c) )
1.6 noro 6783: error("plain_vect_to_ndv_q : components must be integers");
6784: ndl_copy(p,DL(mr)); CZ(mr) = c; NMV_ADV(mr);
1.1 noro 6785: }
6786: MKNDV(nd_nvar,mr0,len,r);
6787: return r;
6788: }
6789: }
6790:
6791: int nd_sp_f4(int m,int trace,ND_pairs l,PGeoBucket bucket)
6792: {
6793: ND_pairs t;
6794: NODE sp0,sp;
6795: int stat;
6796: ND spol;
6797:
6798: for ( t = l; t; t = NEXT(t) ) {
6799: stat = nd_sp(m,trace,t,&spol);
6800: if ( !stat ) return 0;
6801: if ( spol ) {
6802: add_pbucket_symbolic(bucket,spol);
6803: }
6804: }
6805: return 1;
6806: }
6807:
6808: int nd_symbolic_preproc(PGeoBucket bucket,int trace,UINT **s0vect,NODE *r)
6809: {
6810: NODE rp0,rp;
6811: NM mul,head,s0,s;
6812: int index,col,i,sugar;
6813: RHist h;
6814: UINT *s0v,*p;
6815: NM_ind_pair pair;
6816: ND red;
6817: NDV *ps;
6818:
6819: s0 = 0; rp0 = 0; col = 0;
6820: if ( nd_demand )
6821: ps = trace?nd_ps_trace_sym:nd_ps_sym;
6822: else
6823: ps = trace?nd_ps_trace:nd_ps;
6824: while ( 1 ) {
6825: head = remove_head_pbucket_symbolic(bucket);
6826: if ( !head ) break;
6827: if ( !s0 ) s0 = head;
6828: else NEXT(s) = head;
6829: s = head;
6830: index = ndl_find_reducer(DL(head));
6831: if ( index >= 0 ) {
6832: h = nd_psh[index];
6833: NEWNM(mul);
6834: ndl_sub(DL(head),DL(h),DL(mul));
6835: if ( ndl_check_bound2(index,DL(mul)) )
6836: return 0;
6837: sugar = TD(DL(mul))+SG(ps[index]);
6838: MKNM_ind_pair(pair,mul,index,sugar);
6839: red = ndv_mul_nm_symbolic(mul,ps[index]);
6840: add_pbucket_symbolic(bucket,nd_remove_head(red));
6841: NEXTNODE(rp0,rp); BDY(rp) = (pointer)pair;
6842: }
6843: col++;
6844: }
6845: if ( rp0 ) NEXT(rp) = 0;
6846: NEXT(s) = 0;
6847: s0v = (UINT *)MALLOC_ATOMIC(col*nd_wpd*sizeof(UINT));
6848: for ( i = 0, p = s0v, s = s0; i < col;
6849: i++, p += nd_wpd, s = NEXT(s) ) ndl_copy(DL(s),p);
6850: *s0vect = s0v;
6851: *r = rp0;
6852: return col;
6853: }
6854:
6855: void print_ndp(ND_pairs l)
6856: {
6857: ND_pairs t;
6858:
6859: for ( t = l; t; t = NEXT(t) )
6860: printf("[%d,%d] ",t->i1,t->i2);
6861: printf("\n");
6862: }
6863:
6864: NODE nd_f4(int m,int checkonly,int **indp)
6865: {
6866: int i,nh,stat,index,f4red;
6867: NODE r,g,tn0,tn,node;
6868: ND_pairs d,l,t,ll0,ll,lh;
6869: LIST l0,l1;
6870: ND spol,red;
6871: NDV nf,redv;
6872: NM s0,s;
6873: NODE rp0,srp0,nflist,nzlist,nzlist_t;
6874: int nsp,nred,col,rank,len,k,j,a,i1s,i2s;
6875: UINT c;
6876: UINT **spmat;
6877: UINT *s0vect,*svect,*p,*v;
6878: int *colstat;
6879: IndArray *imat;
6880: int *rhead;
6881: int spcol,sprow;
6882: int sugar,sugarh;
6883: PGeoBucket bucket;
6884: struct oEGT eg0,eg1,eg_f4;
6885: Z i1,i2,sugarq;
1.12 noro 6886:
6887: init_eg(&f4_symb); init_eg(&f4_conv); init_eg(&f4_conv); init_eg(&f4_elim1); init_eg(&f4_elim2);
1.1 noro 6888: #if 0
6889: ndv_alloc = 0;
6890: #endif
1.11 noro 6891: Nf4_red=0;
1.1 noro 6892: g = 0; d = 0;
6893: for ( i = 0; i < nd_psn; i++ ) {
6894: d = update_pairs(d,g,i,0);
6895: g = update_base(g,i);
6896: }
6897: nzlist = 0;
6898: nzlist_t = nd_nzlist;
6899: f4red = 1;
6900: nd_last_nonzero = 0;
6901: while ( d ) {
6902: get_eg(&eg0);
6903: l = nd_minsugarp(d,&d);
6904: sugar = nd_sugarweight?l->sugar2:SG(l);
6905: if ( MaxDeg > 0 && sugar > MaxDeg ) break;
6906: if ( nzlist_t ) {
6907: node = BDY((LIST)BDY(nzlist_t));
1.6 noro 6908: sugarh = ZTOS((Q)ARG0(node));
1.1 noro 6909: tn = BDY((LIST)ARG1(node));
6910: if ( !tn ) {
6911: nzlist_t = NEXT(nzlist_t);
6912: continue;
6913: }
6914: /* tn = [[i1,i2],...] */
6915: lh = nd_ipairtospair(tn);
6916: }
6917: bucket = create_pbucket();
6918: stat = nd_sp_f4(m,0,l,bucket);
6919: if ( !stat ) {
6920: for ( t = l; NEXT(t); t = NEXT(t) );
6921: NEXT(t) = d; d = l;
6922: d = nd_reconstruct(0,d);
6923: continue;
6924: }
6925: if ( bucket->m < 0 ) continue;
6926: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
6927: if ( !col ) {
6928: for ( t = l; NEXT(t); t = NEXT(t) );
6929: NEXT(t) = d; d = l;
6930: d = nd_reconstruct(0,d);
6931: continue;
6932: }
1.12 noro 6933: get_eg(&eg1); init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg1); add_eg(&f4_symb,&eg0,&eg1);
1.1 noro 6934: if ( DP_Print )
1.6 noro 6935: fprintf(asir_out,"sugar=%d,symb=%.3fsec,",
1.5 noro 6936: sugar,eg_f4.exectime);
1.1 noro 6937: nflist = nd_f4_red(m,nd_nzlist?lh:l,0,s0vect,col,rp0,nd_gentrace?&ll:0);
6938: if ( checkonly && nflist ) return 0;
6939: /* adding new bases */
6940: if ( nflist ) nd_last_nonzero = f4red;
6941: for ( r = nflist; r; r = NEXT(r) ) {
6942: nf = (NDV)BDY(r);
6943: ndv_removecont(m,nf);
6944: if ( !m && nd_nalg ) {
6945: ND nf1;
6946:
6947: nf1 = ndvtond(m,nf);
6948: nd_monic(0,&nf1);
6949: nd_removecont(m,nf1);
6950: nf = ndtondv(m,nf1);
6951: }
6952: nh = ndv_newps(m,nf,0,1);
6953: d = update_pairs(d,g,nh,0);
6954: g = update_base(g,nh);
6955: }
6956: if ( DP_Print ) {
6957: fprintf(asir_out,"f4red=%d,gblen=%d\n",f4red,length(g)); fflush(asir_out);
6958: }
6959: if ( nd_gentrace ) {
6960: for ( t = ll, tn0 = 0; t; t = NEXT(t) ) {
6961: NEXTNODE(tn0,tn);
1.6 noro 6962: STOZ(t->i1,i1); STOZ(t->i2,i2);
1.1 noro 6963: node = mknode(2,i1,i2); MKLIST(l0,node);
6964: BDY(tn) = l0;
6965: }
6966: if ( tn0 ) NEXT(tn) = 0; MKLIST(l0,tn0);
1.6 noro 6967: STOZ(sugar,sugarq); node = mknode(2,sugarq,l0); MKLIST(l1,node);
1.1 noro 6968: MKNODE(node,l1,nzlist); nzlist = node;
6969: }
6970: if ( nd_nzlist ) nzlist_t = NEXT(nzlist_t);
6971: f4red++;
6972: if ( nd_f4red && f4red > nd_f4red ) break;
6973: if ( nd_rank0 && !nflist ) break;
6974: }
6975: if ( nd_gentrace ) {
6976: MKLIST(l0,reverse_node(nzlist));
6977: MKNODE(nd_alltracelist,l0,0);
6978: }
6979: #if 0
6980: fprintf(asir_out,"ndv_alloc=%d\n",ndv_alloc);
6981: #endif
1.12 noro 6982: if ( DP_Print ) {
6983: fprintf(asir_out,"number of red=%d,",Nf4_red);
6984: fprintf(asir_out,"symb=%.3fsec,conv=%.3fsec,elim1=%.3fsec,elim2=%.3fsec\n",
6985: f4_symb.exectime,f4_conv.exectime,f4_elim1.exectime,f4_elim2.exectime);
6986: }
1.1 noro 6987: conv_ilist(nd_demand,0,g,indp);
6988: return g;
6989: }
6990:
6991: NODE nd_f4_trace(int m,int **indp)
6992: {
6993: int i,nh,stat,index;
6994: NODE r,g;
6995: ND_pairs d,l,l0,t;
6996: ND spol,red;
6997: NDV nf,redv,nfqv,nfv;
6998: NM s0,s;
6999: NODE rp0,srp0,nflist;
7000: int nsp,nred,col,rank,len,k,j,a;
7001: UINT c;
7002: UINT **spmat;
7003: UINT *s0vect,*svect,*p,*v;
7004: int *colstat;
7005: IndArray *imat;
7006: int *rhead;
7007: int spcol,sprow;
7008: int sugar;
7009: PGeoBucket bucket;
7010: struct oEGT eg0,eg1,eg_f4;
7011:
7012: g = 0; d = 0;
7013: for ( i = 0; i < nd_psn; i++ ) {
7014: d = update_pairs(d,g,i,0);
7015: g = update_base(g,i);
7016: }
7017: while ( d ) {
7018: get_eg(&eg0);
7019: l = nd_minsugarp(d,&d);
7020: sugar = SG(l);
7021: if ( MaxDeg > 0 && sugar > MaxDeg ) break;
7022: bucket = create_pbucket();
7023: stat = nd_sp_f4(m,0,l,bucket);
7024: if ( !stat ) {
7025: for ( t = l; NEXT(t); t = NEXT(t) );
7026: NEXT(t) = d; d = l;
7027: d = nd_reconstruct(1,d);
7028: continue;
7029: }
7030: if ( bucket->m < 0 ) continue;
7031: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
7032: if ( !col ) {
7033: for ( t = l; NEXT(t); t = NEXT(t) );
7034: NEXT(t) = d; d = l;
7035: d = nd_reconstruct(1,d);
7036: continue;
7037: }
7038: get_eg(&eg1); init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg1);
7039: if ( DP_Print )
1.3 noro 7040: fprintf(asir_out,"\nsugar=%d,symb=%.3fsec,",
1.5 noro 7041: sugar,eg_f4.exectime);
1.1 noro 7042: nflist = nd_f4_red(m,l,0,s0vect,col,rp0,&l0);
7043: if ( !l0 ) continue;
7044: l = l0;
7045:
7046: /* over Q */
7047: bucket = create_pbucket();
7048: stat = nd_sp_f4(0,1,l,bucket);
7049: if ( !stat ) {
7050: for ( t = l; NEXT(t); t = NEXT(t) );
7051: NEXT(t) = d; d = l;
7052: d = nd_reconstruct(1,d);
7053: continue;
7054: }
7055: if ( bucket->m < 0 ) continue;
7056: col = nd_symbolic_preproc(bucket,1,&s0vect,&rp0);
7057: if ( !col ) {
7058: for ( t = l; NEXT(t); t = NEXT(t) );
7059: NEXT(t) = d; d = l;
7060: d = nd_reconstruct(1,d);
7061: continue;
7062: }
7063: nflist = nd_f4_red(0,l,1,s0vect,col,rp0,0);
7064: /* adding new bases */
7065: for ( r = nflist; r; r = NEXT(r) ) {
7066: nfqv = (NDV)BDY(r);
7067: ndv_removecont(0,nfqv);
1.6 noro 7068: if ( !remqi((Q)HCZ(nfqv),m) ) return 0;
1.1 noro 7069: if ( nd_nalg ) {
7070: ND nf1;
7071:
7072: nf1 = ndvtond(m,nfqv);
7073: nd_monic(0,&nf1);
7074: nd_removecont(0,nf1);
7075: nfqv = ndtondv(0,nf1); nd_free(nf1);
7076: }
7077: nfv = ndv_dup(0,nfqv);
7078: ndv_mod(m,nfv);
7079: ndv_removecont(m,nfv);
7080: nh = ndv_newps(0,nfv,nfqv,1);
7081: d = update_pairs(d,g,nh,0);
7082: g = update_base(g,nh);
7083: }
7084: }
7085: #if 0
7086: fprintf(asir_out,"ndv_alloc=%d\n",ndv_alloc);
7087: #endif
7088: conv_ilist(nd_demand,1,g,indp);
7089: return g;
7090: }
7091:
7092: int rref(matrix mat,int *sugar)
7093: {
7094: int row,col,i,j,k,l,s,wcol,wj;
7095: unsigned long bj;
7096: unsigned long **a;
7097: unsigned long *ai,*ak,*as,*t;
7098: int *pivot;
7099:
7100: row = mat->row;
7101: col = mat->col;
7102: a = mat->a;
7103: wcol = (col+BLEN-1)/BLEN;
7104: pivot = (int *)MALLOC_ATOMIC(row*sizeof(int));
7105: i = 0;
7106: for ( j = 0; j < col; j++ ) {
7107: wj = j/BLEN; bj = 1L<<(j%BLEN);
7108: for ( k = i; k < row; k++ )
7109: if ( a[k][wj] & bj ) break;
7110: if ( k == row ) continue;
7111: pivot[i] = j;
7112: if ( k != i ) {
7113: t = a[i]; a[i] = a[k]; a[k] = t;
7114: s = sugar[i]; sugar[i] = sugar[k]; sugar[k] = s;
7115: }
7116: ai = a[i];
7117: for ( k = i+1; k < row; k++ ) {
7118: ak = a[k];
7119: if ( ak[wj] & bj ) {
7120: for ( l = wj; l < wcol; l++ )
7121: ak[l] ^= ai[l];
7122: sugar[k] = MAX(sugar[k],sugar[i]);
7123: }
7124: }
7125: i++;
7126: }
7127: for ( k = i-1; k >= 0; k-- ) {
7128: j = pivot[k]; wj = j/BLEN; bj = 1L<<(j%BLEN);
7129: ak = a[k];
7130: for ( s = 0; s < k; s++ ) {
7131: as = a[s];
7132: if ( as[wj] & bj ) {
7133: for ( l = wj; l < wcol; l++ )
7134: as[l] ^= ak[l];
7135: sugar[s] = MAX(sugar[s],sugar[k]);
7136: }
7137: }
7138: }
7139: return i;
7140: }
7141:
7142: void print_matrix(matrix mat)
7143: {
7144: int row,col,i,j;
7145: unsigned long *ai;
7146:
7147: row = mat->row;
7148: col = mat->col;
7149: printf("%d x %d\n",row,col);
7150: for ( i = 0; i < row; i++ ) {
7151: ai = mat->a[i];
7152: for ( j = 0; j < col; j++ ) {
7153: if ( ai[j/BLEN] & (1L<<(j%BLEN)) ) putchar('1');
7154: else putchar('0');
7155: }
7156: putchar('\n');
7157: }
7158: }
7159:
7160: NDV vect_to_ndv_2(unsigned long *vect,int col,UINT *s0vect);
7161:
7162: void red_by_vect_2(matrix mat,int *sugar,unsigned long *v,int rhead,int rsugar)
7163: {
7164: int row,col,wcol,wj,i,j;
7165: unsigned long bj;
7166: unsigned long *ai;
7167: unsigned long **a;
7168: int len;
7169: int *pos;
7170:
7171: row = mat->row;
7172: col = mat->col;
7173: wcol = (col+BLEN-1)/BLEN;
7174: pos = (int *)MALLOC(wcol*sizeof(int));
7175: bzero(pos,wcol*sizeof(int));
7176: for ( i = j = 0; i < wcol; i++ )
7177: if ( v[i] ) pos[j++] = i;;
7178: len = j;
7179: wj = rhead/BLEN;
7180: bj = 1L<<rhead%BLEN;
7181: a = mat->a;
7182: for ( i = 0; i < row; i++ ) {
7183: ai = a[i];
7184: if ( ai[wj]&bj ) {
7185: for ( j = 0; j < len; j++ )
7186: ai[pos[j]] ^= v[pos[j]];
7187: sugar[i] = MAX(sugar[i],rsugar);
7188: }
7189: }
7190: }
7191:
7192: NODE nd_f4_red_2(ND_pairs sp0,UINT *s0vect,int col,NODE rp0,ND_pairs *nz)
7193: {
7194: int nsp,nred,i,i0,k,rank,row;
7195: NODE r0,rp;
7196: ND_pairs sp;
7197: ND spol;
7198: NM_ind_pair rt;
7199: int *s0hash;
7200: UINT *s;
7201: int *pivot,*sugar,*head;
7202: matrix mat;
7203: NM m;
7204: NODE r;
7205: struct oEGT eg0,eg1,eg2,eg_elim1,eg_elim2;
7206: int rhead,rsugar,size;
7207: unsigned long *v;
7208:
7209: get_eg(&eg0);
7210: for ( sp = sp0, nsp = 0; sp; sp = NEXT(sp), nsp++ );
7211: nred = length(rp0);
7212: mat = alloc_matrix(nsp,col);
7213: s0hash = (int *)MALLOC(col*sizeof(int));
7214: for ( i = 0, s = s0vect; i < col; i++, s += nd_wpd )
7215: s0hash[i] = ndl_hash_value(s);
7216:
7217: sugar = (int *)MALLOC(nsp*sizeof(int));
7218: for ( i = 0, sp = sp0; sp; sp = NEXT(sp) ) {
7219: nd_sp(2,0,sp,&spol);
7220: if ( spol ) {
7221: mat->a[i] = nd_to_vect_2(s0vect,col,s0hash,spol);
7222: sugar[i] = SG(spol);
7223: i++;
7224: }
7225: }
7226: mat->row = i;
7227: if ( DP_Print ) {
7228: fprintf(asir_out,"%dx%d,",mat->row,mat->col); fflush(asir_out);
7229: }
7230: size = ((col+BLEN-1)/BLEN)*sizeof(unsigned long);
7231: v = CALLOC((col+BLEN-1)/BLEN,sizeof(unsigned long));
7232: for ( rp = rp0, i = 0; rp; rp = NEXT(rp), i++ ) {
7233: rt = (NM_ind_pair)BDY(rp);
7234: bzero(v,size);
7235: rhead = nd_nm_to_vect_2(s0vect,col,s0hash,nd_ps[rt->index],rt->mul,v);
7236: rsugar = SG(nd_ps[rt->index])+TD(DL(rt->mul));
7237: red_by_vect_2(mat,sugar,v,rhead,rsugar);
7238: }
7239:
7240: get_eg(&eg1);
7241: init_eg(&eg_elim1); add_eg(&eg_elim1,&eg0,&eg1);
7242: rank = rref(mat,sugar);
7243:
7244: for ( i = 0, r0 = 0; i < rank; i++ ) {
7245: NEXTNODE(r0,r);
7246: BDY(r) = (pointer)vect_to_ndv_2(mat->a[i],col,s0vect);
7247: SG((NDV)BDY(r)) = sugar[i];
7248: }
7249: if ( r0 ) NEXT(r) = 0;
7250: get_eg(&eg2);
7251: init_eg(&eg_elim2); add_eg(&eg_elim2,&eg1,&eg2);
7252: if ( DP_Print ) {
7253: fprintf(asir_out,"elim1=%.3fsec,elim2=%.3fsec,",
1.5 noro 7254: eg_elim1.exectime,eg_elim2.exectime);
1.1 noro 7255: fflush(asir_out);
7256: }
7257: return r0;
7258: }
7259:
7260:
7261: NODE nd_f4_red(int m,ND_pairs sp0,int trace,UINT *s0vect,int col,NODE rp0,ND_pairs *nz)
7262: {
7263: IndArray *imat;
1.11 noro 7264: int nsp,nred,i,start;
1.1 noro 7265: int *rhead;
7266: NODE r0,rp;
7267: ND_pairs sp;
7268: NM_ind_pair *rvect;
7269: UINT *s;
7270: int *s0hash;
1.11 noro 7271: struct oEGT eg0,eg1,eg_conv;
1.1 noro 7272:
7273: if ( m == 2 && nd_rref2 )
7274: return nd_f4_red_2(sp0,s0vect,col,rp0,nz);
7275:
7276: for ( sp = sp0, nsp = 0; sp; sp = NEXT(sp), nsp++ );
7277: nred = length(rp0);
7278: imat = (IndArray *)MALLOC(nred*sizeof(IndArray));
7279: rhead = (int *)MALLOC(col*sizeof(int));
7280: for ( i = 0; i < col; i++ ) rhead[i] = 0;
7281:
7282: /* construction of index arrays */
1.11 noro 7283: get_eg(&eg0);
1.1 noro 7284: if ( DP_Print ) {
1.11 noro 7285: fprintf(asir_out,"%dx%d,",nsp+nred,col);
7286: fflush(asir_out);
1.1 noro 7287: }
7288: rvect = (NM_ind_pair *)MALLOC(nred*sizeof(NM_ind_pair));
1.11 noro 7289: for ( start = 0, rp = rp0, i = 0; rp; i++, rp = NEXT(rp) ) {
1.1 noro 7290: rvect[i] = (NM_ind_pair)BDY(rp);
1.11 noro 7291: imat[i] = nm_ind_pair_to_vect_compress(trace,s0vect,col,rvect[i],start);
1.1 noro 7292: rhead[imat[i]->head] = 1;
1.11 noro 7293: start = imat[i]->head;
7294: }
1.12 noro 7295: get_eg(&eg1); init_eg(&eg_conv); add_eg(&eg_conv,&eg0,&eg1); add_eg(&f4_conv,&eg0,&eg1);
1.11 noro 7296: if ( DP_Print ) {
7297: fprintf(asir_out,"conv=%.3fsec,",eg_conv.exectime);
7298: fflush(asir_out);
1.1 noro 7299: }
7300: if ( m > 0 )
1.7 noro 7301: #if SIZEOF_LONG==8
1.1 noro 7302: r0 = nd_f4_red_mod64_main(m,sp0,nsp,s0vect,col,rvect,rhead,imat,nred,nz);
7303: #else
7304: r0 = nd_f4_red_main(m,sp0,nsp,s0vect,col,rvect,rhead,imat,nred,nz);
7305: #endif
7306: else if ( m == -1 )
7307: r0 = nd_f4_red_sf_main(m,sp0,nsp,s0vect,col,rvect,rhead,imat,nred,nz);
7308: else if ( m == -2 )
7309: r0 = nd_f4_red_lf_main(m,sp0,nsp,trace,s0vect,col,rvect,rhead,imat,nred);
7310: else
7311: r0 = nd_f4_red_q_main(sp0,nsp,trace,s0vect,col,rvect,rhead,imat,nred);
7312: return r0;
7313: }
7314:
7315: /* for Fp, 2<=p<2^16 */
7316:
7317: NODE nd_f4_red_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
7318: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz)
7319: {
7320: int spcol,sprow,a;
7321: int i,j,k,l,rank;
7322: NODE r0,r;
7323: ND_pairs sp;
7324: ND spol;
7325: UINT **spmat;
7326: UINT *svect,*v;
7327: int *colstat;
7328: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
7329: int maxrs;
7330: int *spsugar;
7331: ND_pairs *spactive;
7332:
7333: spcol = col-nred;
7334: get_eg(&eg0);
7335: /* elimination (1st step) */
7336: spmat = (UINT **)MALLOC(nsp*sizeof(UINT *));
7337: svect = (UINT *)MALLOC(col*sizeof(UINT));
7338: spsugar = (int *)MALLOC(nsp*sizeof(int));
7339: spactive = !nz?0:(ND_pairs *)MALLOC(nsp*sizeof(ND_pairs));
7340: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
7341: nd_sp(m,0,sp,&spol);
7342: if ( !spol ) continue;
7343: nd_to_vect(m,s0vect,col,spol,svect);
7344: if ( m == -1 )
7345: maxrs = ndv_reduce_vect_sf(m,svect,col,imat,rvect,nred);
7346: else
7347: maxrs = ndv_reduce_vect(m,svect,col,imat,rvect,nred);
7348: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
7349: if ( i < col ) {
7350: spmat[sprow] = v = (UINT *)MALLOC_ATOMIC(spcol*sizeof(UINT));
7351: for ( j = k = 0; j < col; j++ )
7352: if ( !rhead[j] ) v[k++] = svect[j];
7353: spsugar[sprow] = MAX(maxrs,SG(spol));
7354: if ( nz )
7355: spactive[sprow] = sp;
7356: sprow++;
7357: }
7358: nd_free(spol);
7359: }
7360: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
7361: if ( DP_Print ) {
1.5 noro 7362: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 7363: fflush(asir_out);
7364: }
7365: /* free index arrays */
7366: for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c);
7367:
7368: /* elimination (2nd step) */
7369: colstat = (int *)MALLOC(spcol*sizeof(int));
7370: if ( m == -1 )
7371: rank = nd_gauss_elim_sf(spmat,spsugar,sprow,spcol,m,colstat);
7372: else
7373: rank = nd_gauss_elim_mod(spmat,spsugar,spactive,sprow,spcol,m,colstat);
7374: r0 = 0;
7375: for ( i = 0; i < rank; i++ ) {
7376: NEXTNODE(r0,r); BDY(r) =
7377: (pointer)vect_to_ndv(spmat[i],spcol,col,rhead,s0vect);
7378: SG((NDV)BDY(r)) = spsugar[i];
7379: GCFREE(spmat[i]);
7380: }
7381: if ( r0 ) NEXT(r) = 0;
7382:
7383: for ( ; i < sprow; i++ ) GCFREE(spmat[i]);
7384: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
7385: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
7386: if ( DP_Print ) {
1.5 noro 7387: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 7388: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
7389: nsp,nred,sprow,spcol,rank);
1.5 noro 7390: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 7391: }
7392: if ( nz ) {
7393: for ( i = 0; i < rank-1; i++ ) NEXT(spactive[i]) = spactive[i+1];
7394: if ( rank > 0 ) {
7395: NEXT(spactive[rank-1]) = 0;
7396: *nz = spactive[0];
7397: } else
7398: *nz = 0;
7399: }
7400: return r0;
7401: }
7402:
7403:
7404: /* for small finite fields */
7405:
7406: NODE nd_f4_red_sf_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
7407: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz)
7408: {
7409: int spcol,sprow,a;
7410: int i,j,k,l,rank;
7411: NODE r0,r;
7412: ND_pairs sp;
7413: ND spol;
7414: UINT **spmat;
7415: UINT *svect,*v;
7416: int *colstat;
7417: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
7418: int maxrs;
7419: int *spsugar;
7420: ND_pairs *spactive;
7421:
7422: spcol = col-nred;
7423: get_eg(&eg0);
7424: /* elimination (1st step) */
7425: spmat = (UINT **)MALLOC(nsp*sizeof(UINT *));
7426: svect = (UINT *)MALLOC(col*sizeof(UINT));
7427: spsugar = (int *)MALLOC(nsp*sizeof(int));
7428: spactive = !nz?0:(ND_pairs *)MALLOC(nsp*sizeof(ND_pairs));
7429: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
7430: nd_sp(m,0,sp,&spol);
7431: if ( !spol ) continue;
7432: nd_to_vect(m,s0vect,col,spol,svect);
7433: maxrs = ndv_reduce_vect_sf(m,svect,col,imat,rvect,nred);
7434: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
7435: if ( i < col ) {
7436: spmat[sprow] = v = (UINT *)MALLOC_ATOMIC(spcol*sizeof(UINT));
7437: for ( j = k = 0; j < col; j++ )
7438: if ( !rhead[j] ) v[k++] = svect[j];
7439: spsugar[sprow] = MAX(maxrs,SG(spol));
7440: if ( nz )
7441: spactive[sprow] = sp;
7442: sprow++;
7443: }
7444: nd_free(spol);
7445: }
7446: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
7447: if ( DP_Print ) {
1.5 noro 7448: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 7449: fflush(asir_out);
7450: }
7451: /* free index arrays */
7452: for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c);
7453:
7454: /* elimination (2nd step) */
7455: colstat = (int *)MALLOC(spcol*sizeof(int));
7456: rank = nd_gauss_elim_sf(spmat,spsugar,sprow,spcol,m,colstat);
7457: r0 = 0;
7458: for ( i = 0; i < rank; i++ ) {
7459: NEXTNODE(r0,r); BDY(r) =
7460: (pointer)vect_to_ndv(spmat[i],spcol,col,rhead,s0vect);
7461: SG((NDV)BDY(r)) = spsugar[i];
7462: GCFREE(spmat[i]);
7463: }
7464: if ( r0 ) NEXT(r) = 0;
7465:
7466: for ( ; i < sprow; i++ ) GCFREE(spmat[i]);
7467: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
7468: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
7469: if ( DP_Print ) {
1.5 noro 7470: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 7471: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
7472: nsp,nred,sprow,spcol,rank);
1.5 noro 7473: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 7474: }
7475: if ( nz ) {
7476: for ( i = 0; i < rank-1; i++ ) NEXT(spactive[i]) = spactive[i+1];
7477: if ( rank > 0 ) {
7478: NEXT(spactive[rank-1]) = 0;
7479: *nz = spactive[0];
7480: } else
7481: *nz = 0;
7482: }
7483: return r0;
7484: }
7485:
7486: NODE nd_f4_red_lf_main(int m,ND_pairs sp0,int nsp,int trace,UINT *s0vect,int col,
7487: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred)
7488: {
7489: int spcol,sprow,a;
7490: int i,j,k,l,rank;
7491: NODE r0,r;
7492: ND_pairs sp;
7493: ND spol;
7494: mpz_t **spmat;
7495: mpz_t *svect,*v;
7496: int *colstat;
7497: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
7498: int maxrs;
7499: int *spsugar;
7500: pointer *w;
7501:
7502: spcol = col-nred;
7503: get_eg(&eg0);
7504: /* elimination (1st step) */
7505: spmat = (mpz_t **)MALLOC(nsp*sizeof(mpz_t *));
7506: svect = (mpz_t *)MALLOC(col*sizeof(mpz_t));
7507: spsugar = (int *)MALLOC(nsp*sizeof(int));
7508: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
7509: nd_sp(m,trace,sp,&spol);
7510: if ( !spol ) continue;
7511: nd_to_vect_lf(s0vect,col,spol,svect);
7512: maxrs = ndv_reduce_vect_lf(svect,trace,col,imat,rvect,nred);
7513: for ( i = 0; i < col; i++ ) if ( mpz_sgn(svect[i]) ) break;
7514: if ( i < col ) {
7515: spmat[sprow] = v = (mpz_t *)MALLOC(spcol*sizeof(mpz_t));
7516: for ( j = k = 0; j < col; j++ )
7517: if ( !rhead[j] ) v[k++][0] = svect[j][0];
7518: spsugar[sprow] = MAX(maxrs,SG(spol));
7519: sprow++;
7520: }
7521: /* nd_free(spol); */
7522: }
7523: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
7524: if ( DP_Print ) {
1.5 noro 7525: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 7526: fflush(asir_out);
7527: }
7528: /* free index arrays */
7529: /* for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c); */
7530:
7531: /* elimination (2nd step) */
7532: colstat = (int *)MALLOC(spcol*sizeof(int));
7533: rank = nd_gauss_elim_lf(spmat,spsugar,sprow,spcol,colstat);
7534: w = (pointer *)MALLOC(rank*sizeof(pointer));
7535: for ( i = 0; i < rank; i++ ) {
7536: #if 0
7537: w[rank-i-1] = (pointer)vect_to_ndv_lf(spmat[i],spcol,col,rhead,s0vect);
7538: SG((NDV)w[rank-i-1]) = spsugar[i];
7539: #else
7540: w[i] = (pointer)vect_to_ndv_lf(spmat[i],spcol,col,rhead,s0vect);
7541: SG((NDV)w[i]) = spsugar[i];
7542: #endif
7543: /* GCFREE(spmat[i]); */
7544:
7545: }
7546: #if 0
7547: qsort(w,rank,sizeof(NDV),
7548: (int (*)(const void *,const void *))ndv_compare);
7549: #endif
7550: r0 = 0;
7551: for ( i = 0; i < rank; i++ ) {
7552: NEXTNODE(r0,r); BDY(r) = w[i];
7553: }
7554: if ( r0 ) NEXT(r) = 0;
7555:
7556: /* for ( ; i < sprow; i++ ) GCFREE(spmat[i]); */
7557: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
7558: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
7559: if ( DP_Print ) {
1.5 noro 7560: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 7561: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
7562: nsp,nred,sprow,spcol,rank);
1.5 noro 7563: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 7564: }
7565: return r0;
7566: }
7567:
7568: NODE nd_f4_red_q_main(ND_pairs sp0,int nsp,int trace,UINT *s0vect,int col,
7569: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred)
7570: {
7571: int spcol,sprow,a;
7572: int i,j,k,l,rank;
7573: NODE r0,r;
7574: ND_pairs sp;
7575: ND spol;
7576: Z **spmat;
7577: Z *svect,*v;
7578: int *colstat;
7579: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
7580: int maxrs;
7581: int *spsugar;
7582: pointer *w;
7583:
7584: spcol = col-nred;
7585: get_eg(&eg0);
7586: /* elimination (1st step) */
7587: spmat = (Z **)MALLOC(nsp*sizeof(Q *));
7588: svect = (Z *)MALLOC(col*sizeof(Q));
7589: spsugar = (int *)MALLOC(nsp*sizeof(int));
7590: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
7591: nd_sp(0,trace,sp,&spol);
7592: if ( !spol ) continue;
7593: nd_to_vect_q(s0vect,col,spol,svect);
7594: maxrs = ndv_reduce_vect_q(svect,trace,col,imat,rvect,nred);
7595: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
7596: if ( i < col ) {
7597: spmat[sprow] = v = (Z *)MALLOC(spcol*sizeof(Q));
7598: for ( j = k = 0; j < col; j++ )
7599: if ( !rhead[j] ) v[k++] = svect[j];
7600: spsugar[sprow] = MAX(maxrs,SG(spol));
7601: sprow++;
7602: }
7603: /* nd_free(spol); */
7604: }
7605: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
7606: if ( DP_Print ) {
1.5 noro 7607: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 7608: fflush(asir_out);
7609: }
7610: /* free index arrays */
7611: /* for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c); */
7612:
7613: /* elimination (2nd step) */
7614: colstat = (int *)MALLOC(spcol*sizeof(int));
7615: rank = nd_gauss_elim_q(spmat,spsugar,sprow,spcol,colstat);
7616: w = (pointer *)MALLOC(rank*sizeof(pointer));
7617: for ( i = 0; i < rank; i++ ) {
7618: #if 0
7619: w[rank-i-1] = (pointer)vect_to_ndv_q(spmat[i],spcol,col,rhead,s0vect);
7620: SG((NDV)w[rank-i-1]) = spsugar[i];
7621: #else
7622: w[i] = (pointer)vect_to_ndv_q(spmat[i],spcol,col,rhead,s0vect);
7623: SG((NDV)w[i]) = spsugar[i];
7624: #endif
7625: /* GCFREE(spmat[i]); */
7626: }
7627: #if 0
7628: qsort(w,rank,sizeof(NDV),
7629: (int (*)(const void *,const void *))ndv_compare);
7630: #endif
7631: r0 = 0;
7632: for ( i = 0; i < rank; i++ ) {
7633: NEXTNODE(r0,r); BDY(r) = w[i];
7634: }
7635: if ( r0 ) NEXT(r) = 0;
7636:
7637: /* for ( ; i < sprow; i++ ) GCFREE(spmat[i]); */
7638: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
7639: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
7640: if ( DP_Print ) {
1.5 noro 7641: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 7642: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
7643: nsp,nred,sprow,spcol,rank);
1.5 noro 7644: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 7645: }
7646: return r0;
7647: }
7648:
7649: FILE *nd_write,*nd_read;
7650:
7651: void nd_send_int(int a) {
7652: write_int(nd_write,(unsigned int *)&a);
7653: }
7654:
7655: void nd_send_intarray(int *p,int len) {
7656: write_intarray(nd_write,(unsigned int *)p,len);
7657: }
7658:
7659: int nd_recv_int() {
7660: int a;
7661:
7662: read_int(nd_read,(unsigned int *)&a);
7663: return a;
7664: }
7665:
7666: void nd_recv_intarray(int *p,int len) {
7667: read_intarray(nd_read,(unsigned int *)p,len);
7668: }
7669:
7670: void nd_send_ndv(NDV p) {
7671: int len,i;
7672: NMV m;
7673:
7674: if ( !p ) nd_send_int(0);
7675: else {
7676: len = LEN(p);
7677: nd_send_int(len);
7678: m = BDY(p);
7679: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
7680: nd_send_int(CM(m));
7681: nd_send_intarray((int *)DL(m),nd_wpd);
7682: }
7683: }
7684: }
7685:
7686: void nd_send_nd(ND p) {
7687: int len,i;
7688: NM m;
7689:
7690: if ( !p ) nd_send_int(0);
7691: else {
7692: len = LEN(p);
7693: nd_send_int(len);
7694: m = BDY(p);
7695: for ( i = 0; i < len; i++, m = NEXT(m) ) {
7696: nd_send_int(CM(m));
7697: nd_send_intarray((int *)DL(m),nd_wpd);
7698: }
7699: }
7700: }
7701:
7702: NDV nd_recv_ndv()
7703: {
7704: int len,i;
7705: NMV m,m0;
7706: NDV r;
7707:
7708: len = nd_recv_int();
7709: if ( !len ) return 0;
7710: else {
7711: m0 = m = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
7712: #if 0
7713: ndv_alloc += len*nmv_adv;
7714: #endif
7715: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
7716: CM(m) = nd_recv_int();
7717: nd_recv_intarray((int *)DL(m),nd_wpd);
7718: }
7719: MKNDV(nd_nvar,m0,len,r);
7720: return r;
7721: }
7722: }
7723:
7724: int nd_gauss_elim_q(Z **mat0,int *sugar,int row,int col,int *colstat)
7725: {
7726: int i,j,t,c,rank,inv;
7727: int *ci,*ri;
7728: Z dn;
7729: MAT m,nm;
7730:
7731: NEWMAT(m); m->row = row; m->col = col; m->body = (pointer **)mat0;
7732: rank = generic_gauss_elim(m,&nm,&dn,&ri,&ci);
7733: for ( i = 0; i < row; i++ )
7734: for ( j = 0; j < col; j++ )
7735: mat0[i][j] = 0;
7736: c = col-rank;
7737: for ( i = 0; i < rank; i++ ) {
7738: mat0[i][ri[i]] = dn;
7739: for ( j = 0; j < c; j++ )
7740: mat0[i][ci[j]] = (Z)BDY(nm)[i][j];
7741: }
7742: return rank;
7743: }
7744:
7745: int nd_gauss_elim_mod(UINT **mat0,int *sugar,ND_pairs *spactive,int row,int col,int md,int *colstat)
7746: {
7747: int i,j,k,l,inv,a,rank,s;
7748: unsigned int *t,*pivot,*pk;
7749: unsigned int **mat;
7750: ND_pairs pair;
7751:
7752: mat = (unsigned int **)mat0;
7753: for ( rank = 0, j = 0; j < col; j++ ) {
7754: for ( i = rank; i < row; i++ )
7755: mat[i][j] %= md;
7756: for ( i = rank; i < row; i++ )
7757: if ( mat[i][j] )
7758: break;
7759: if ( i == row ) {
7760: colstat[j] = 0;
7761: continue;
7762: } else
7763: colstat[j] = 1;
7764: if ( i != rank ) {
7765: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
7766: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
7767: if ( spactive ) {
7768: pair = spactive[i]; spactive[i] = spactive[rank];
7769: spactive[rank] = pair;
7770: }
7771: }
7772: pivot = mat[rank];
7773: s = sugar[rank];
7774: inv = invm(pivot[j],md);
7775: for ( k = j, pk = pivot+k; k < col; k++, pk++ )
7776: if ( *pk ) {
7777: if ( *pk >= (unsigned int)md )
7778: *pk %= md;
7779: DMAR(*pk,inv,0,md,*pk)
7780: }
7781: for ( i = rank+1; i < row; i++ ) {
7782: t = mat[i];
7783: if ( (a = t[j]) != 0 ) {
7784: sugar[i] = MAX(sugar[i],s);
7785: red_by_vect(md,t+j,pivot+j,md-a,col-j);
7786: }
7787: }
7788: rank++;
7789: }
7790: for ( j = col-1, l = rank-1; j >= 0; j-- )
7791: if ( colstat[j] ) {
7792: pivot = mat[l];
7793: s = sugar[l];
7794: for ( i = 0; i < l; i++ ) {
7795: t = mat[i];
7796: t[j] %= md;
7797: if ( (a = t[j]) != 0 ) {
7798: sugar[i] = MAX(sugar[i],s);
7799: red_by_vect(md,t+j,pivot+j,md-a,col-j);
7800: }
7801: }
7802: l--;
7803: }
7804: for ( j = 0, l = 0; l < rank; j++ )
7805: if ( colstat[j] ) {
7806: t = mat[l];
7807: for ( k = j; k < col; k++ )
7808: if ( t[k] >= (unsigned int)md )
7809: t[k] %= md;
7810: l++;
7811: }
7812: return rank;
7813: }
7814:
7815:
1.7 noro 7816: int nd_gauss_elim_sf(UINT **mat0,int *sugar,int row,int col,int md,int *colstat)
1.1 noro 7817: {
1.7 noro 7818: int i,j,k,l,inv,a,rank,s;
7819: unsigned int *t,*pivot,*pk;
7820: unsigned int **mat;
7821:
7822: mat = (unsigned int **)mat0;
7823: for ( rank = 0, j = 0; j < col; j++ ) {
7824: for ( i = rank; i < row; i++ )
7825: if ( mat[i][j] )
7826: break;
7827: if ( i == row ) {
7828: colstat[j] = 0;
7829: continue;
7830: } else
7831: colstat[j] = 1;
7832: if ( i != rank ) {
7833: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
7834: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
7835: }
7836: pivot = mat[rank];
7837: s = sugar[rank];
7838: inv = _invsf(pivot[j]);
7839: for ( k = j, pk = pivot+k; k < col; k++, pk++ )
7840: if ( *pk )
7841: *pk = _mulsf(*pk,inv);
7842: for ( i = rank+1; i < row; i++ ) {
7843: t = mat[i];
7844: if ( (a = t[j]) != 0 ) {
7845: sugar[i] = MAX(sugar[i],s);
7846: red_by_vect_sf(md,t+j,pivot+j,_chsgnsf(a),col-j);
7847: }
7848: }
7849: rank++;
7850: }
7851: for ( j = col-1, l = rank-1; j >= 0; j-- )
7852: if ( colstat[j] ) {
7853: pivot = mat[l];
7854: s = sugar[l];
7855: for ( i = 0; i < l; i++ ) {
7856: t = mat[i];
7857: if ( (a = t[j]) != 0 ) {
7858: sugar[i] = MAX(sugar[i],s);
7859: red_by_vect_sf(md,t+j,pivot+j,_chsgnsf(a),col-j);
7860: }
7861: }
7862: l--;
7863: }
7864: return rank;
7865: }
1.1 noro 7866:
1.7 noro 7867: int ndv_ishomo(NDV p)
7868: {
7869: NMV m;
7870: int len,h;
1.1 noro 7871:
7872: if ( !p ) return 1;
7873: len = LEN(p);
7874: m = BDY(p);
7875: h = TD(DL(m));
7876: NMV_ADV(m);
7877: for ( len--; len; len--, NMV_ADV(m) )
1.20 ! noro 7878: if ( TD(DL(m)) != h ) {
! 7879: return 0;
! 7880: }
1.1 noro 7881: return 1;
7882: }
7883:
7884: void ndv_save(NDV p,int index)
7885: {
7886: FILE *s;
7887: char name[BUFSIZ];
7888: short id;
7889: int nv,sugar,len,n,i,td,e,j;
7890: NMV m;
7891: unsigned int *dl;
7892: int mpos;
7893:
7894: sprintf(name,"%s/%d",Demand,index);
7895: s = fopen(name,"w");
7896: savevl(s,0);
7897: if ( !p ) {
7898: saveobj(s,0);
7899: return;
7900: }
7901: id = O_DP;
7902: nv = NV(p);
7903: sugar = SG(p);
7904: len = LEN(p);
7905: write_short(s,(unsigned short *)&id); write_int(s,(unsigned int *)&nv); write_int(s,(unsigned int *)&sugar);
7906: write_int(s,(unsigned int *)&len);
7907:
7908: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
1.6 noro 7909: saveobj(s,(Obj)CZ(m));
1.1 noro 7910: dl = DL(m);
7911: td = TD(dl);
7912: write_int(s,(unsigned int *)&td);
7913: for ( j = 0; j < nv; j++ ) {
7914: e = GET_EXP(dl,j);
7915: write_int(s,(unsigned int *)&e);
7916: }
7917: if ( nd_module ) {
7918: mpos = MPOS(dl); write_int(s,(unsigned int *)&mpos);
7919: }
7920: }
7921: fclose(s);
7922: }
7923:
7924: void nd_save_mod(ND p,int index)
7925: {
7926: FILE *s;
7927: char name[BUFSIZ];
7928: int nv,sugar,len,c;
7929: NM m;
7930:
7931: sprintf(name,"%s/%d",Demand,index);
7932: s = fopen(name,"w");
7933: if ( !p ) {
7934: len = 0;
7935: write_int(s,(unsigned int *)&len);
7936: fclose(s);
7937: return;
7938: }
7939: nv = NV(p);
7940: sugar = SG(p);
7941: len = LEN(p);
7942: write_int(s,(unsigned int *)&nv); write_int(s,(unsigned int *)&sugar); write_int(s,(unsigned int *)&len);
7943: for ( m = BDY(p); m; m = NEXT(m) ) {
7944: c = CM(m); write_int(s,(unsigned int *)&c);
7945: write_intarray(s,(unsigned int *)DL(m),nd_wpd);
7946: }
7947: fclose(s);
7948: }
7949:
7950: NDV ndv_load(int index)
7951: {
7952: FILE *s;
7953: char name[BUFSIZ];
7954: short id;
7955: int nv,sugar,len,n,i,td,e,j;
7956: NDV d;
7957: NMV m0,m;
7958: unsigned int *dl;
7959: Obj obj;
7960: int mpos;
7961:
7962: sprintf(name,"%s/%d",Demand,index);
7963: s = fopen(name,"r");
7964: if ( !s ) return 0;
7965:
7966: skipvl(s);
7967: read_short(s,(unsigned short *)&id);
7968: if ( !id ) return 0;
7969: read_int(s,(unsigned int *)&nv);
7970: read_int(s,(unsigned int *)&sugar);
7971: read_int(s,(unsigned int *)&len);
7972:
7973: m0 = m = MALLOC(len*nmv_adv);
7974: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
1.6 noro 7975: loadobj(s,&obj); CZ(m) = (Z)obj;
1.1 noro 7976: dl = DL(m);
7977: ndl_zero(dl);
7978: read_int(s,(unsigned int *)&td); TD(dl) = td;
7979: for ( j = 0; j < nv; j++ ) {
7980: read_int(s,(unsigned int *)&e);
7981: PUT_EXP(dl,j,e);
7982: }
7983: if ( nd_module ) {
7984: read_int(s,(unsigned int *)&mpos); MPOS(dl) = mpos;
7985: }
7986: if ( nd_blockmask ) ndl_weight_mask(dl);
7987: }
7988: fclose(s);
7989: MKNDV(nv,m0,len,d);
7990: SG(d) = sugar;
7991: return d;
7992: }
7993:
7994: ND nd_load_mod(int index)
7995: {
7996: FILE *s;
7997: char name[BUFSIZ];
7998: int nv,sugar,len,i,c;
7999: ND d;
8000: NM m0,m;
8001:
8002: sprintf(name,"%s/%d",Demand,index);
8003: s = fopen(name,"r");
8004: /* if the file does not exist, it means p[index]=0 */
8005: if ( !s ) return 0;
8006:
8007: read_int(s,(unsigned int *)&nv);
8008: if ( !nv ) { fclose(s); return 0; }
8009:
8010: read_int(s,(unsigned int *)&sugar);
8011: read_int(s,(unsigned int *)&len);
8012: for ( m0 = 0, i = 0; i < len; i++ ) {
8013: NEXTNM(m0,m);
8014: read_int(s,(unsigned int *)&c); CM(m) = c;
8015: read_intarray(s,(unsigned int *)DL(m),nd_wpd);
8016: }
8017: NEXT(m) = 0;
8018: MKND(nv,m0,len,d);
8019: SG(d) = sugar;
8020: fclose(s);
8021: return d;
8022: }
8023:
8024: void nd_det(int mod,MAT f,P *rp)
8025: {
8026: VL fv,tv;
8027: int n,i,j,max,e,nvar,sgn,k0,l0,len0,len,k,l,a;
8028: pointer **m;
8029: P **w;
8030: P mp,r;
8031: NDV **dm;
8032: NDV *t,*mi,*mj;
8033: NDV d,s,mij,mjj;
8034: ND u;
8035: NMV nmv;
8036: UINT *bound;
8037: PGeoBucket bucket;
8038: struct order_spec *ord;
8039: Z dq,dt,ds;
8040: Z mone;
8041: Z gn,qn,dn0,nm,dn;
8042:
8043: create_order_spec(0,0,&ord);
8044: nd_init_ord(ord);
8045: get_vars((Obj)f,&fv);
8046: if ( f->row != f->col )
8047: error("nd_det : non-square matrix");
8048: n = f->row;
8049: m = f->body;
8050: for ( nvar = 0, tv = fv; tv; tv = NEXT(tv), nvar++ );
8051:
8052: if ( !nvar ) {
8053: if ( !mod )
8054: detp(CO,(P **)m,n,rp);
8055: else {
8056: w = (P **)almat_pointer(n,n);
8057: for ( i = 0; i < n; i++ )
8058: for ( j = 0; j < n; j++ )
8059: ptomp(mod,(P)m[i][j],&w[i][j]);
8060: detmp(CO,mod,w,n,&mp);
8061: mptop(mp,rp);
8062: }
8063: return;
8064: }
8065:
8066: if ( !mod ) {
8067: w = (P **)almat_pointer(n,n);
8068: dq = ONE;
8069: for ( i = 0; i < n; i++ ) {
8070: dn0 = ONE;
8071: for ( j = 0; j < n; j++ ) {
8072: if ( !m[i][j] ) continue;
8073: lgp(m[i][j],&nm,&dn);
1.6 noro 8074: gcdz(dn0,dn,&gn); divsz(dn0,gn,&qn); mulz(qn,dn,&dn0);
1.1 noro 8075: }
8076: if ( !UNIZ(dn0) ) {
8077: ds = dn0;
8078: for ( j = 0; j < n; j++ )
8079: mulp(CO,(P)m[i][j],(P)ds,&w[i][j]);
8080: mulz(dq,ds,&dt); dq = dt;
8081: } else
8082: for ( j = 0; j < n; j++ )
8083: w[i][j] = (P)m[i][j];
8084: }
8085: m = (pointer **)w;
8086: }
8087:
8088: for ( i = 0, max = 1; i < n; i++ )
8089: for ( j = 0; j < n; j++ )
8090: for ( tv = fv; tv; tv = NEXT(tv) ) {
8091: e = getdeg(tv->v,(P)m[i][j]);
8092: max = MAX(e,max);
8093: }
8094: nd_setup_parameters(nvar,max);
8095: dm = (NDV **)almat_pointer(n,n);
8096: for ( i = 0, max = 1; i < n; i++ )
8097: for ( j = 0; j < n; j++ ) {
8098: dm[i][j] = ptondv(CO,fv,m[i][j]);
8099: if ( mod ) ndv_mod(mod,dm[i][j]);
8100: if ( dm[i][j] && !LEN(dm[i][j]) ) dm[i][j] = 0;
8101: }
8102: d = ptondv(CO,fv,(P)ONE);
8103: if ( mod ) ndv_mod(mod,d);
8104: chsgnz(ONE,&mone);
8105: for ( j = 0, sgn = 1; j < n; j++ ) {
8106: if ( DP_Print ) {
8107: fprintf(asir_out,".");
8108: }
8109: for ( i = j; i < n && !dm[i][j]; i++ );
8110: if ( i == n ) {
8111: *rp = 0;
8112: return;
8113: }
8114: k0 = i; l0 = j; len0 = LEN(dm[k0][l0]);
8115: for ( k = j; k < n; k++ )
8116: for ( l = j; l < n; l++ )
8117: if ( dm[k][l] && LEN(dm[k][l]) < len0 ) {
8118: k0 = k; l0 = l; len0 = LEN(dm[k][l]);
8119: }
8120: if ( k0 != j ) {
8121: t = dm[j]; dm[j] = dm[k0]; dm[k0] = t;
8122: sgn = -sgn;
8123: }
8124: if ( l0 != j ) {
8125: for ( k = j; k < n; k++ ) {
8126: s = dm[k][j]; dm[k][j] = dm[k][l0]; dm[k][l0] = s;
8127: }
8128: sgn = -sgn;
8129: }
8130: bound = nd_det_compute_bound(dm,n,j);
8131: for ( k = 0; k < nd_nvar; k++ )
8132: if ( bound[k]*2 > nd_mask0 ) break;
8133: if ( k < nd_nvar )
8134: nd_det_reconstruct(dm,n,j,d);
8135:
8136: for ( i = j+1, mj = dm[j], mjj = mj[j]; i < n; i++ ) {
8137: /* if ( DP_Print ) fprintf(asir_out," i=%d\n ",i); */
8138: mi = dm[i]; mij = mi[j];
8139: if ( mod )
8140: ndv_mul_c(mod,mij,mod-1);
8141: else
8142: ndv_mul_c_q(mij,mone);
8143: for ( k = j+1; k < n; k++ ) {
8144: /* if ( DP_Print ) fprintf(asir_out,"k=%d ",k); */
8145: bucket = create_pbucket();
8146: if ( mi[k] ) {
8147: nmv = BDY(mjj); len = LEN(mjj);
8148: for ( a = 0; a < len; a++, NMV_ADV(nmv) ) {
8149: u = ndv_mul_nmv_trunc(mod,nmv,mi[k],DL(BDY(d)));
8150: add_pbucket(mod,bucket,u);
8151: }
8152: }
8153: if ( mj[k] && mij ) {
8154: nmv = BDY(mij); len = LEN(mij);
8155: for ( a = 0; a < len; a++, NMV_ADV(nmv) ) {
8156: u = ndv_mul_nmv_trunc(mod,nmv,mj[k],DL(BDY(d)));
8157: add_pbucket(mod,bucket,u);
8158: }
8159: }
8160: u = nd_quo(mod,bucket,d);
8161: mi[k] = ndtondv(mod,u);
8162: }
8163: /* if ( DP_Print ) fprintf(asir_out,"\n",k); */
8164: }
8165: d = mjj;
8166: }
8167: if ( DP_Print ) {
8168: fprintf(asir_out,"\n");
8169: }
8170: if ( sgn < 0 ) {
8171: if ( mod )
8172: ndv_mul_c(mod,d,mod-1);
8173: else
8174: ndv_mul_c_q(d,mone);
8175: }
8176: r = ndvtop(mod,CO,fv,d);
8177: if ( !mod && !UNIQ(dq) )
8178: divsp(CO,r,(P)dq,rp);
8179: else
8180: *rp = r;
8181: }
8182:
8183: ND ndv_mul_nmv_trunc(int mod,NMV m0,NDV p,UINT *d)
8184: {
8185: NM mr,mr0;
8186: NM tnm;
8187: NMV m;
8188: UINT *d0,*dt,*dm;
8189: int c,n,td,i,c1,c2,len;
8190: Z q;
8191: ND r;
8192:
8193: if ( !p ) return 0;
8194: else {
8195: n = NV(p); m = BDY(p); len = LEN(p);
8196: d0 = DL(m0);
8197: td = TD(d);
8198: mr0 = 0;
8199: NEWNM(tnm);
8200: if ( mod ) {
8201: c = CM(m0);
8202: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
8203: ndl_add(DL(m),d0,DL(tnm));
8204: if ( ndl_reducible(DL(tnm),d) ) {
8205: NEXTNM(mr0,mr);
8206: c1 = CM(m); DMAR(c1,c,0,mod,c2); CM(mr) = c2;
8207: ndl_copy(DL(tnm),DL(mr));
8208: }
8209: }
8210: } else {
1.6 noro 8211: q = CZ(m0);
1.1 noro 8212: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
8213: ndl_add(DL(m),d0,DL(tnm));
8214: if ( ndl_reducible(DL(tnm),d) ) {
8215: NEXTNM(mr0,mr);
1.6 noro 8216: mulz(CZ(m),q,&CZ(mr));
1.1 noro 8217: ndl_copy(DL(tnm),DL(mr));
8218: }
8219: }
8220: }
8221: if ( !mr0 )
8222: return 0;
8223: else {
8224: NEXT(mr) = 0;
8225: for ( len = 0, mr = mr0; mr; mr = NEXT(mr), len++ );
8226: MKND(NV(p),mr0,len,r);
8227: SG(r) = SG(p) + TD(d0);
8228: return r;
8229: }
8230: }
8231: }
8232:
8233: void nd_det_reconstruct(NDV **dm,int n,int j,NDV d)
8234: {
8235: int i,obpe,oadv,h,k,l;
8236: static NM prev_nm_free_list;
8237: EPOS oepos;
8238:
8239: obpe = nd_bpe;
8240: oadv = nmv_adv;
8241: oepos = nd_epos;
8242: if ( obpe < 2 ) nd_bpe = 2;
8243: else if ( obpe < 3 ) nd_bpe = 3;
8244: else if ( obpe < 4 ) nd_bpe = 4;
8245: else if ( obpe < 5 ) nd_bpe = 5;
8246: else if ( obpe < 6 ) nd_bpe = 6;
8247: else if ( obpe < 8 ) nd_bpe = 8;
8248: else if ( obpe < 10 ) nd_bpe = 10;
8249: else if ( obpe < 16 ) nd_bpe = 16;
8250: else if ( obpe < 32 ) nd_bpe = 32;
8251: else error("nd_det_reconstruct : exponent too large");
8252:
8253: nd_setup_parameters(nd_nvar,0);
8254: prev_nm_free_list = _nm_free_list;
8255: _nm_free_list = 0;
8256: for ( k = j; k < n; k++ )
8257: for (l = j; l < n; l++ )
8258: ndv_realloc(dm[k][l],obpe,oadv,oepos);
8259: ndv_realloc(d,obpe,oadv,oepos);
8260: prev_nm_free_list = 0;
8261: #if 0
8262: GC_gcollect();
8263: #endif
8264: }
8265:
8266: /* returns a UINT array containing degree bounds */
8267:
8268: UINT *nd_det_compute_bound(NDV **dm,int n,int j)
8269: {
8270: UINT *d0,*d1,*d,*t,*r;
8271: int k,l,i;
8272:
8273: d0 = (UINT *)MALLOC(nd_nvar*sizeof(UINT));
8274: for ( k = 0; k < nd_nvar; k++ ) d0[k] = 0;
8275: for ( k = j; k < n; k++ )
8276: for ( l = j; l < n; l++ )
8277: if ( dm[k][l] ) {
8278: d = ndv_compute_bound(dm[k][l]);
8279: for ( i = 0; i < nd_nvar; i++ )
8280: d0[i] = MAX(d0[i],d[i]);
8281: }
8282: return d0;
8283: }
8284:
8285: DL nd_separate_d(UINT *d,UINT *trans)
8286: {
8287: int n,td,i,e,j;
8288: DL a;
8289:
8290: ndl_zero(trans);
8291: td = 0;
8292: for ( i = 0; i < nd_ntrans; i++ ) {
8293: e = GET_EXP(d,i);
8294: PUT_EXP(trans,i,e);
8295: td += MUL_WEIGHT(e,i);
8296: }
8297: if ( nd_ntrans+nd_nalg < nd_nvar ) {
8298: /* homogenized */
8299: i = nd_nvar-1;
8300: e = GET_EXP(d,i);
8301: PUT_EXP(trans,i,e);
8302: td += MUL_WEIGHT(e,i);
8303: }
8304: TD(trans) = td;
8305: if ( nd_blockmask) ndl_weight_mask(trans);
8306: NEWDL(a,nd_nalg);
8307: td = 0;
8308: for ( i = 0; i < nd_nalg; i++ ) {
8309: j = nd_ntrans+i;
8310: e = GET_EXP(d,j);
8311: a->d[i] = e;
8312: td += e;
8313: }
8314: a->td = td;
8315: return a;
8316: }
8317:
8318: int nd_monic(int mod,ND *p)
8319: {
8320: UINT *trans,*t;
8321: DL alg;
8322: MP mp0,mp;
8323: NM m,m0,m1,ma0,ma,mb,mr0,mr;
8324: ND r;
8325: DL dl;
8326: DP nm;
8327: NDV ndv;
8328: DAlg inv,cd;
8329: ND s,c;
8330: Z l,mul;
8331: Z ln;
8332: int n,ntrans,i,e,td,is_lc,len;
8333: NumberField nf;
8334: struct oEGT eg0,eg1;
8335:
8336: if ( !(nf = get_numberfield()) )
8337: error("nd_monic : current_numberfield is not set");
8338:
8339: /* Q coef -> DAlg coef */
8340: NEWNM(ma0); ma = ma0;
8341: m = BDY(*p);
8342: is_lc = 1;
8343: while ( 1 ) {
8344: NEWMP(mp0); mp = mp0;
1.6 noro 8345: mp->c = (Obj)CZ(m);
1.1 noro 8346: mp->dl = nd_separate_d(DL(m),DL(ma));
8347: NEWNM(mb);
8348: for ( m = NEXT(m); m; m = NEXT(m) ) {
8349: alg = nd_separate_d(DL(m),DL(mb));
8350: if ( !ndl_equal(DL(ma),DL(mb)) )
8351: break;
1.6 noro 8352: NEXTMP(mp0,mp); mp->c = (Obj)CZ(m); mp->dl = alg;
1.1 noro 8353: }
8354: NEXT(mp) = 0;
8355: MKDP(nd_nalg,mp0,nm);
8356: MKDAlg(nm,ONE,cd);
8357: if ( is_lc == 1 ) {
8358: /* if the lc is a rational number, we have nothing to do */
8359: if ( !mp0->dl->td )
8360: return 1;
8361:
8362: get_eg(&eg0);
8363: invdalg(cd,&inv);
8364: get_eg(&eg1); add_eg(&eg_invdalg,&eg0,&eg1);
8365: /* check the validity of inv */
8366: if ( mod && !remqi((Q)inv->dn,mod) )
8367: return 0;
8368: CA(ma) = nf->one;
8369: is_lc = 0;
8370: ln = ONE;
8371: } else {
8372: muldalg(cd,inv,&CA(ma));
8373: lcmz(ln,CA(ma)->dn,&ln);
8374: }
8375: if ( m ) {
8376: NEXT(ma) = mb; ma = mb;
8377: } else {
8378: NEXT(ma) = 0;
8379: break;
8380: }
8381: }
8382: /* l = lcm(denoms) */
8383: l = ln;
8384: for ( mr0 = 0, m = ma0; m; m = NEXT(m) ) {
1.6 noro 8385: divsz(l,CA(m)->dn,&mul);
1.1 noro 8386: for ( mp = BDY(CA(m)->nm); mp; mp = NEXT(mp) ) {
8387: NEXTNM(mr0,mr);
1.6 noro 8388: mulz((Z)mp->c,mul,&CZ(mr));
1.1 noro 8389: dl = mp->dl;
8390: td = TD(DL(m));
8391: ndl_copy(DL(m),DL(mr));
8392: for ( i = 0; i < nd_nalg; i++ ) {
8393: e = dl->d[i];
8394: PUT_EXP(DL(mr),i+nd_ntrans,e);
8395: td += MUL_WEIGHT(e,i+nd_ntrans);
8396: }
8397: if ( nd_module ) MPOS(DL(mr)) = MPOS(DL(m));
8398: TD(DL(mr)) = td;
8399: if ( nd_blockmask) ndl_weight_mask(DL(mr));
8400: }
8401: }
8402: NEXT(mr) = 0;
8403: for ( len = 0, mr = mr0; mr; mr = NEXT(mr), len++ );
8404: MKND(NV(*p),mr0,len,r);
8405: /* XXX */
8406: SG(r) = SG(*p);
8407: nd_free(*p);
8408: *p = r;
8409: return 1;
8410: }
8411:
8412: NODE reverse_node(NODE n)
8413: {
8414: NODE t,t1;
8415:
8416: for ( t = 0; n; n = NEXT(n) ) {
8417: MKNODE(t1,BDY(n),t); t = t1;
8418: }
8419: return t;
8420: }
8421:
8422: P ndc_div(int mod,union oNDC a,union oNDC b)
8423: {
8424: union oNDC c;
8425: int inv,t;
8426:
8427: if ( mod == -1 ) c.m = _mulsf(a.m,_invsf(b.m));
1.10 noro 8428: else if ( mod == -2 ) divlf(a.z,b.z,&c.z);
1.1 noro 8429: else if ( mod ) {
8430: inv = invm(b.m,mod);
8431: DMAR(a.m,inv,0,mod,t); c.m = t;
8432: } else if ( nd_vc )
8433: divsp(nd_vc,a.p,b.p,&c.p);
8434: else
8435: divsz(a.z,b.z,&c.z);
8436: return ndctop(mod,c);
8437: }
8438:
8439: P ndctop(int mod,union oNDC c)
8440: {
8441: Z q;
8442: int e;
8443: GFS gfs;
8444:
8445: if ( mod == -1 ) {
8446: e = IFTOF(c.m); MKGFS(e,gfs); return (P)gfs;
8447: } else if ( mod == -2 ) {
1.10 noro 8448: q = c.z; return (P)q;
1.1 noro 8449: } else if ( mod > 0 ) {
1.6 noro 8450: STOZ(c.m,q); return (P)q;
1.1 noro 8451: } else
8452: return (P)c.p;
8453: }
8454:
8455: /* [0,0,0,cont] = p -> p/cont */
8456:
8457: void finalize_tracelist(int i,P cont)
8458: {
8459: LIST l;
8460: NODE node;
8461: Z iq;
8462:
8463: if ( !UNIQ(cont) ) {
8464: node = mknode(4,NULLP,NULLP,NULLP,cont);
8465: MKLIST(l,node); MKNODE(node,l,nd_tracelist);
8466: nd_tracelist = node;
8467: }
1.6 noro 8468: STOZ(i,iq);
1.1 noro 8469: nd_tracelist = reverse_node(nd_tracelist);
8470: MKLIST(l,nd_tracelist);
8471: node = mknode(2,iq,l); MKLIST(l,node);
8472: MKNODE(node,l,nd_alltracelist); MKLIST(l,node);
8473: nd_alltracelist = node; nd_tracelist = 0;
8474: }
8475:
8476: void conv_ilist(int demand,int trace,NODE g,int **indp)
8477: {
8478: int n,i,j;
8479: int *ind;
8480: NODE t;
8481:
8482: n = length(g);
8483: ind = (int *)MALLOC(n*sizeof(int));
8484: for ( i = 0, t = g; i < n; i++, t = NEXT(t) ) {
8485: j = (long)BDY(t); ind[i] = j;
8486: BDY(t) = (pointer)(demand?ndv_load(j):(trace?nd_ps_trace[j]:nd_ps[j]));
8487: }
8488: if ( indp ) *indp = ind;
8489: }
8490:
8491: void parse_nd_option(NODE opt)
8492: {
8493: NODE t,p,u;
8494: int i,s,n;
8495: char *key;
8496: Obj value;
8497:
8498: nd_gentrace = 0; nd_gensyz = 0; nd_nora = 0; nd_gbblock = 0;
8499: nd_newelim = 0; nd_intersect = 0; nd_nzlist = 0;
8500: nd_splist = 0; nd_check_splist = 0;
8501: nd_sugarweight = 0;
8502: nd_f4red =0;
8503: nd_rank0 = 0;
8504: for ( t = opt; t; t = NEXT(t) ) {
8505: p = BDY((LIST)BDY(t));
8506: key = BDY((STRING)BDY(p));
8507: value = (Obj)BDY(NEXT(p));
8508: if ( !strcmp(key,"gentrace") )
8509: nd_gentrace = value?1:0;
8510: else if ( !strcmp(key,"gensyz") )
8511: nd_gensyz = value?1:0;
8512: else if ( !strcmp(key,"nora") )
8513: nd_nora = value?1:0;
8514: else if ( !strcmp(key,"gbblock") ) {
8515: if ( value && OID(value) == O_LIST ) {
8516: u = BDY((LIST)value);
8517: nd_gbblock = MALLOC((2*length(u)+1)*sizeof(int));
8518: for ( i = 0; u; u = NEXT(u) ) {
8519: p = BDY((LIST)BDY(u));
1.6 noro 8520: s = nd_gbblock[i++] = ZTOS((Q)BDY(p));
8521: nd_gbblock[i++] = s+ZTOS((Q)BDY(NEXT(p)))-1;
1.1 noro 8522: }
8523: nd_gbblock[i] = -1;
8524: } else
8525: nd_gbblock = 0;
8526: } else if ( !strcmp(key,"newelim") )
8527: nd_newelim = value?1:0;
8528: else if ( !strcmp(key,"intersect") )
8529: nd_intersect = value?1:0;
1.17 noro 8530: else if ( !strcmp(key,"syzgen") )
8531: nd_intersect = ZTOS((Q)value);
1.1 noro 8532: else if ( !strcmp(key,"lf") )
8533: nd_lf = value?1:0;
8534: else if ( !strcmp(key,"trace") ) {
8535: if ( value ) {
8536: u = BDY((LIST)value);
8537: nd_nzlist = BDY((LIST)ARG2(u));
1.6 noro 8538: nd_bpe = ZTOS((Q)ARG3(u));
1.1 noro 8539: }
8540: } else if ( !strcmp(key,"f4red") ) {
1.6 noro 8541: nd_f4red = ZTOS((Q)value);
1.1 noro 8542: } else if ( !strcmp(key,"rank0") ) {
8543: nd_rank0 = value?1:0;
8544: } else if ( !strcmp(key,"splist") ) {
8545: nd_splist = value?1:0;
8546: } else if ( !strcmp(key,"check_splist") ) {
8547: nd_check_splist = BDY((LIST)value);
8548: } else if ( !strcmp(key,"sugarweight") ) {
8549: u = BDY((LIST)value);
8550: n = length(u);
8551: nd_sugarweight = MALLOC(n*sizeof(int));
8552: for ( i = 0; i < n; i++, u = NEXT(u) )
1.6 noro 8553: nd_sugarweight[i] = ZTOS((Q)BDY(u));
1.1 noro 8554: }
8555: }
8556: }
8557:
8558: ND mdptond(DP d);
8559: ND nd_mul_nm(int mod,NM m0,ND p);
8560: ND nd_mul_nm_lf(NM m0,ND p);
8561: ND *btog(NODE ti,ND **p,int nb,int mod);
8562: ND btog_one(NODE ti,ND *p,int nb,int mod);
8563: MAT nd_btog(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,MAT *rp);
8564: VECT nd_btog_one(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,int pos,MAT *rp);
8565:
8566: /* d:monomial */
8567: ND mdptond(DP d)
8568: {
8569: NM m;
8570: ND r;
8571:
8572: if ( OID(d) == 1 )
8573: r = ptond(CO,CO,(P)d);
8574: else {
8575: NEWNM(m);
8576: dltondl(NV(d),BDY(d)->dl,DL(m));
1.6 noro 8577: CZ(m) = (Z)BDY(d)->c;
1.1 noro 8578: NEXT(m) = 0;
8579: MKND(NV(d),m,1,r);
8580: }
8581: return r;
8582: }
8583:
8584: ND nd_mul_nm(int mod,NM m0,ND p)
8585: {
8586: UINT *d0;
8587: int c0,c1,c;
8588: NM tm,mr,mr0;
8589: ND r;
8590:
8591: if ( !p ) return 0;
8592: d0 = DL(m0);
8593: c0 = CM(m0);
8594: mr0 = 0;
8595: for ( tm = BDY(p); tm; tm = NEXT(tm) ) {
8596: NEXTNM(mr0,mr);
8597: c = CM(tm); DMAR(c0,c,0,mod,c1); CM(mr) = c1;
8598: ndl_add(d0,DL(tm),DL(mr));
8599: }
8600: NEXT(mr) = 0;
8601: MKND(NV(p),mr0,LEN(p),r);
8602: return r;
8603: }
8604:
8605: ND nd_mul_nm_lf(NM m0,ND p)
8606: {
8607: UINT *d0;
8608: Z c0,c1,c;
8609: NM tm,mr,mr0;
8610: ND r;
8611:
8612: if ( !p ) return 0;
8613: d0 = DL(m0);
8614: c0 = CZ(m0);
8615: mr0 = 0;
8616: for ( tm = BDY(p); tm; tm = NEXT(tm) ) {
8617: NEXTNM(mr0,mr);
8618: c = CZ(tm); mullf(c0,CZ(tm),&c1); CZ(mr) = c1;
8619: ndl_add(d0,DL(tm),DL(mr));
8620: }
8621: NEXT(mr) = 0;
8622: MKND(NV(p),mr0,LEN(p),r);
8623: return r;
8624: }
8625:
8626: ND *btog(NODE ti,ND **p,int nb,int mod)
8627: {
8628: PGeoBucket *r;
8629: int i,ci;
8630: NODE t,s;
8631: ND m,tp;
8632: ND *pi,*rd;
8633: P c;
8634:
8635: r = (PGeoBucket *)MALLOC(nb*sizeof(PGeoBucket));
8636: for ( i = 0; i < nb; i++ )
8637: r[i] = create_pbucket();
8638: for ( t = ti; t; t = NEXT(t) ) {
8639: s = BDY((LIST)BDY(t));
8640: if ( ARG0(s) ) {
8641: m = mdptond((DP)ARG2(s));
1.6 noro 8642: ptomp(mod,(P)HCZ(m),&c);
1.1 noro 8643: if ( (ci = ((MQ)c)->cont) != 0 ) {
8644: HCM(m) = ci;
1.6 noro 8645: pi = p[ZTOS((Q)ARG1(s))];
1.1 noro 8646: for ( i = 0; i < nb; i++ ) {
8647: tp = nd_mul_nm(mod,BDY(m),pi[i]);
8648: add_pbucket(mod,r[i],tp);
8649: }
8650: }
8651: ci = 1;
8652: } else {
8653: ptomp(mod,(P)ARG3(s),&c); ci = ((MQ)c)->cont;
8654: ci = invm(ci,mod);
8655: }
8656: }
8657: rd = (ND *)MALLOC(nb*sizeof(ND));
8658: for ( i = 0; i < nb; i++ )
8659: rd[i] = normalize_pbucket(mod,r[i]);
8660: if ( ci != 1 )
8661: for ( i = 0; i < nb; i++ ) nd_mul_c(mod,rd[i],ci);
8662: return rd;
8663: }
8664:
8665: /* YYY */
8666: ND *btog_lf(NODE ti,ND **p,int nb)
8667: {
8668: PGeoBucket *r;
8669: int i;
8670: NODE t,s;
8671: ND m,tp;
8672: ND *pi,*rd;
8673: LM lm;
8674: Z lf,c;
8675:
8676: r = (PGeoBucket *)MALLOC(nb*sizeof(PGeoBucket));
8677: for ( i = 0; i < nb; i++ )
8678: r[i] = create_pbucket();
8679: for ( t = ti; t; t = NEXT(t) ) {
8680: s = BDY((LIST)BDY(t));
8681: if ( ARG0(s) ) {
8682: m = mdptond((DP)ARG2(s));
1.6 noro 8683: simp_ff((Obj)HCZ(m),(Obj *)&lm);
1.1 noro 8684: if ( lm ) {
8685: lmtolf(lm,&lf); HCZ(m) = lf;
1.6 noro 8686: pi = p[ZTOS((Q)ARG1(s))];
1.1 noro 8687: for ( i = 0; i < nb; i++ ) {
8688: tp = nd_mul_nm_lf(BDY(m),pi[i]);
8689: add_pbucket(-2,r[i],tp);
8690: }
8691: }
8692: c = ONE;
8693: } else {
8694: simp_ff((Obj)ARG3(s),(Obj *)&lm); lmtolf(lm,&lf); invz(lf,current_mod_lf,&c);
8695: }
8696: }
8697: rd = (ND *)MALLOC(nb*sizeof(ND));
8698: for ( i = 0; i < nb; i++ )
8699: rd[i] = normalize_pbucket(-2,r[i]);
8700: for ( i = 0; i < nb; i++ ) nd_mul_c_lf(rd[i],c);
8701: return rd;
8702: }
8703:
8704: ND btog_one(NODE ti,ND *p,int nb,int mod)
8705: {
8706: PGeoBucket r;
8707: int i,ci,j;
8708: NODE t,s;
8709: ND m,tp;
8710: ND pi,rd;
8711: P c;
8712:
8713: r = create_pbucket();
8714: for ( t = ti; t; t = NEXT(t) ) {
8715: s = BDY((LIST)BDY(t));
8716: if ( ARG0(s) ) {
8717: m = mdptond((DP)ARG2(s));
1.6 noro 8718: ptomp(mod,(P)HCZ(m),&c);
1.1 noro 8719: if ( (ci = ((MQ)c)->cont) != 0 ) {
8720: HCM(m) = ci;
1.6 noro 8721: pi = p[j=ZTOS((Q)ARG1(s))];
1.1 noro 8722: if ( !pi ) {
8723: pi = nd_load_mod(j);
8724: tp = nd_mul_nm(mod,BDY(m),pi);
8725: nd_free(pi);
8726: add_pbucket(mod,r,tp);
8727: } else {
8728: tp = nd_mul_nm(mod,BDY(m),pi);
8729: add_pbucket(mod,r,tp);
8730: }
8731: }
8732: ci = 1;
8733: } else {
8734: ptomp(mod,(P)ARG3(s),&c); ci = ((MQ)c)->cont;
8735: ci = invm(ci,mod);
8736: }
8737: }
8738: rd = normalize_pbucket(mod,r);
8739: free_pbucket(r);
8740: if ( ci != 1 ) nd_mul_c(mod,rd,ci);
8741: return rd;
8742: }
8743:
8744: MAT nd_btog_lf(LIST f,LIST v,struct order_spec *ord,LIST tlist,MAT *rp);
8745:
8746: MAT nd_btog(LIST f,LIST v,int mod,struct order_spec *ord,LIST tlist,MAT *rp)
8747: {
8748: int i,j,n,m,nb,pi0,pi1,nvar;
8749: VL fv,tv,vv;
8750: NODE permtrace,perm,trace,intred,ind,t,pi,ti;
8751: ND **p;
8752: ND *c;
8753: ND u;
8754: P inv;
8755: MAT mat;
8756:
8757: if ( mod == -2 )
8758: return nd_btog_lf(f,v,ord,tlist,rp);
8759:
8760: parse_nd_option(current_option);
8761: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
8762: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
8763: switch ( ord->id ) {
8764: case 1:
8765: if ( ord->nv != nvar )
8766: error("nd_check : invalid order specification");
8767: break;
8768: default:
8769: break;
8770: }
8771: nd_init_ord(ord);
8772: #if 0
1.6 noro 8773: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 8774: #else
8775: nd_bpe = 32;
8776: #endif
8777: nd_setup_parameters(nvar,0);
8778: permtrace = BDY((LIST)ARG2(BDY(tlist)));
8779: intred = BDY((LIST)ARG3(BDY(tlist)));
8780: ind = BDY((LIST)ARG4(BDY(tlist)));
8781: perm = BDY((LIST)BDY(permtrace)); trace =NEXT(permtrace);
8782: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 8783: j = ZTOS((Q)BDY(BDY((LIST)BDY(t))));
1.1 noro 8784: if ( j > i ) i = j;
8785: }
8786: n = i+1;
8787: nb = length(BDY(f));
8788: p = (ND **)MALLOC(n*sizeof(ND *));
8789: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
8790: pi = BDY((LIST)BDY(t));
1.6 noro 8791: pi0 = ZTOS((Q)ARG0(pi)); pi1 = ZTOS((Q)ARG1(pi));
1.1 noro 8792: p[pi0] = c = (ND *)MALLOC(nb*sizeof(ND));
8793: ptomp(mod,(P)ARG2(pi),&inv);
8794: ((MQ)inv)->cont = invm(((MQ)inv)->cont,mod);
8795: u = ptond(CO,vv,(P)ONE);
8796: HCM(u) = ((MQ)inv)->cont;
8797: c[pi1] = u;
8798: }
8799: for ( t = trace,i=0; t; t = NEXT(t), i++ ) {
8800: printf("%d ",i); fflush(stdout);
8801: ti = BDY((LIST)BDY(t));
1.6 noro 8802: p[j=ZTOS((Q)ARG0(ti))] = btog(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 8803: }
8804: for ( t = intred, i=0; t; t = NEXT(t), i++ ) {
8805: printf("%d ",i); fflush(stdout);
8806: ti = BDY((LIST)BDY(t));
1.6 noro 8807: p[j=ZTOS((Q)ARG0(ti))] = btog(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 8808: }
8809: m = length(ind);
8810: MKMAT(mat,nb,m);
8811: for ( j = 0, t = ind; j < m; j++, t = NEXT(t) )
1.6 noro 8812: for ( i = 0, c = p[ZTOS((Q)BDY(t))]; i < nb; i++ )
1.1 noro 8813: BDY(mat)[i][j] = ndtodp(mod,c[i]);
8814: return mat;
8815: }
8816:
8817: MAT nd_btog_lf(LIST f,LIST v,struct order_spec *ord,LIST tlist,MAT *rp)
8818: {
8819: int i,j,n,m,nb,pi0,pi1,nvar;
8820: VL fv,tv,vv;
8821: NODE permtrace,perm,trace,intred,ind,t,pi,ti;
8822: ND **p;
8823: ND *c;
8824: ND u;
8825: MAT mat;
8826: LM lm;
8827: Z lf,inv;
8828:
8829: parse_nd_option(current_option);
8830: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
8831: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
8832: switch ( ord->id ) {
8833: case 1:
8834: if ( ord->nv != nvar )
8835: error("nd_check : invalid order specification");
8836: break;
8837: default:
8838: break;
8839: }
8840: nd_init_ord(ord);
8841: #if 0
1.6 noro 8842: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 8843: #else
8844: nd_bpe = 32;
8845: #endif
8846: nd_setup_parameters(nvar,0);
8847: permtrace = BDY((LIST)ARG2(BDY(tlist)));
8848: intred = BDY((LIST)ARG3(BDY(tlist)));
8849: ind = BDY((LIST)ARG4(BDY(tlist)));
8850: perm = BDY((LIST)BDY(permtrace)); trace =NEXT(permtrace);
8851: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 8852: j = ZTOS((Q)BDY(BDY((LIST)BDY(t))));
1.1 noro 8853: if ( j > i ) i = j;
8854: }
8855: n = i+1;
8856: nb = length(BDY(f));
8857: p = (ND **)MALLOC(n*sizeof(ND *));
8858: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
8859: pi = BDY((LIST)BDY(t));
1.6 noro 8860: pi0 = ZTOS((Q)ARG0(pi)); pi1 = ZTOS((Q)ARG1(pi));
1.1 noro 8861: p[pi0] = c = (ND *)MALLOC(nb*sizeof(ND));
8862: simp_ff((Obj)ARG2(pi),(Obj *)&lm); lmtolf(lm,&lf); invz(lf,current_mod_lf,&inv);
8863: u = ptond(CO,vv,(P)ONE);
8864: HCZ(u) = inv;
8865: c[pi1] = u;
8866: }
8867: for ( t = trace,i=0; t; t = NEXT(t), i++ ) {
8868: printf("%d ",i); fflush(stdout);
8869: ti = BDY((LIST)BDY(t));
1.6 noro 8870: p[j=ZTOS((Q)ARG0(ti))] = btog_lf(BDY((LIST)ARG1(ti)),p,nb);
1.1 noro 8871: }
8872: for ( t = intred, i=0; t; t = NEXT(t), i++ ) {
8873: printf("%d ",i); fflush(stdout);
8874: ti = BDY((LIST)BDY(t));
1.6 noro 8875: p[j=ZTOS((Q)ARG0(ti))] = btog_lf(BDY((LIST)ARG1(ti)),p,nb);
1.1 noro 8876: }
8877: m = length(ind);
8878: MKMAT(mat,nb,m);
8879: for ( j = 0, t = ind; j < m; j++, t = NEXT(t) )
1.6 noro 8880: for ( i = 0, c = p[ZTOS((Q)BDY(t))]; i < nb; i++ )
1.1 noro 8881: BDY(mat)[i][j] = ndtodp(-2,c[i]);
8882: return mat;
8883: }
8884:
8885: VECT nd_btog_one(LIST f,LIST v,int mod,struct order_spec *ord,
8886: LIST tlist,int pos,MAT *rp)
8887: {
8888: int i,j,n,m,nb,pi0,pi1,nvar;
8889: VL fv,tv,vv;
8890: NODE permtrace,perm,trace,intred,ind,t,pi,ti;
8891: ND *p;
8892: ND *c;
8893: ND u;
8894: P inv;
8895: VECT vect;
8896:
8897: if ( mod == -2 )
8898: error("nd_btog_one : not implemented yet for a large finite field");
8899:
8900: parse_nd_option(current_option);
8901: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
8902: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
8903: switch ( ord->id ) {
8904: case 1:
8905: if ( ord->nv != nvar )
8906: error("nd_check : invalid order specification");
8907: break;
8908: default:
8909: break;
8910: }
8911: nd_init_ord(ord);
8912: #if 0
1.6 noro 8913: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 8914: #else
8915: nd_bpe = 32;
8916: #endif
8917: nd_setup_parameters(nvar,0);
8918: permtrace = BDY((LIST)ARG2(BDY(tlist)));
8919: intred = BDY((LIST)ARG3(BDY(tlist)));
8920: ind = BDY((LIST)ARG4(BDY(tlist)));
8921: perm = BDY((LIST)BDY(permtrace)); trace =NEXT(permtrace);
8922: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 8923: j = ZTOS((Q)BDY(BDY((LIST)BDY(t))));
1.1 noro 8924: if ( j > i ) i = j;
8925: }
8926: n = i+1;
8927: nb = length(BDY(f));
8928: p = (ND *)MALLOC(n*sizeof(ND *));
8929: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
8930: pi = BDY((LIST)BDY(t));
1.6 noro 8931: pi0 = ZTOS((Q)ARG0(pi)); pi1 = ZTOS((Q)ARG1(pi));
1.1 noro 8932: if ( pi1 == pos ) {
8933: ptomp(mod,(P)ARG2(pi),&inv);
8934: ((MQ)inv)->cont = invm(((MQ)inv)->cont,mod);
8935: u = ptond(CO,vv,(P)ONE);
8936: HCM(u) = ((MQ)inv)->cont;
8937: p[pi0] = u;
8938: }
8939: }
8940: for ( t = trace,i=0; t; t = NEXT(t), i++ ) {
8941: printf("%d ",i); fflush(stdout);
8942: ti = BDY((LIST)BDY(t));
1.6 noro 8943: p[j=ZTOS((Q)ARG0(ti))] = btog_one(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 8944: if ( Demand ) {
8945: nd_save_mod(p[j],j); nd_free(p[j]); p[j] = 0;
8946: }
8947: }
8948: for ( t = intred, i=0; t; t = NEXT(t), i++ ) {
8949: printf("%d ",i); fflush(stdout);
8950: ti = BDY((LIST)BDY(t));
1.6 noro 8951: p[j=ZTOS((Q)ARG0(ti))] = btog_one(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 8952: if ( Demand ) {
8953: nd_save_mod(p[j],j); nd_free(p[j]); p[j] = 0;
8954: }
8955: }
8956: m = length(ind);
8957: MKVECT(vect,m);
8958: for ( j = 0, t = ind; j < m; j++, t = NEXT(t) ) {
1.6 noro 8959: u = p[ZTOS((Q)BDY(t))];
1.1 noro 8960: if ( !u ) {
1.6 noro 8961: u = nd_load_mod(ZTOS((Q)BDY(t)));
1.1 noro 8962: BDY(vect)[j] = ndtodp(mod,u);
8963: nd_free(u);
8964: } else
8965: BDY(vect)[j] = ndtodp(mod,u);
8966: }
8967: return vect;
8968: }
8969:
8970: void ndv_print_lf(NDV p)
8971: {
8972: NMV m;
8973: int i,len;
8974:
8975: if ( !p ) printf("0\n");
8976: else {
8977: len = LEN(p);
8978: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
8979: printf("+");
8980: mpz_out_str(asir_out,10,BDY(CZ(m)));
8981: printf("*");
8982: ndl_print(DL(m));
8983: }
8984: printf("\n");
8985: }
8986: }
8987:
8988: void nd_f4_lf_trace(LIST f,LIST v,int trace,int homo,struct order_spec *ord,LIST *rp)
8989: {
8990: VL tv,fv,vv,vc,av;
8991: NODE fd,fd0,in0,in,r,r0,t,s,cand,alist;
8992: int m,nocheck,nvar,mindex,e,max;
8993: NDV c;
8994: NMV a;
8995: P p,zp;
8996: Q dmy;
8997: EPOS oepos;
8998: int obpe,oadv,wmax,i,len,cbpe,ishomo,nalg,mrank,trank,ompos;
8999: Alg alpha,dp;
9000: P poly;
9001: LIST f1,f2,zpl;
9002: Obj obj;
9003: NumberField nf;
9004: struct order_spec *ord1;
9005: struct oEGT eg_check,eg0,eg1;
9006: NODE tr,tl1,tl2,tl3,tl4;
9007: LIST l1,l2,l3,l4,l5;
9008: int *perm;
9009: int j,ret;
9010: NODE retn;
9011: Q jq,bpe;
9012:
9013: nd_module = 0;
9014: parse_nd_option(current_option);
9015: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
9016: if ( nd_vc )
9017: error("nd_f4_lf_trace : computation over a rational function field is not implemented");
9018: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
9019: switch ( ord->id ) {
9020: case 1:
9021: if ( ord->nv != nvar )
9022: error("nd_f4_lf_trace : invalid order specification");
9023: break;
9024: default:
9025: break;
9026: }
9027:
9028: nd_ntrans = nvar;
9029: nd_nalg = 0;
9030:
9031: nocheck = 0;
9032: mindex = 0;
9033:
9034: /* do not use on-demand load/save */
9035: nd_demand = 0;
9036: m = trace > 1 ? trace : get_lprime(mindex);
9037: nd_init_ord(ord);
9038: mrank = 0;
9039: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
9040: for ( tv = vv; tv; tv = NEXT(tv) ) {
9041: if ( nd_module ) {
9042: s = BDY((LIST)BDY(t));
9043: trank = length(s);
9044: mrank = MAX(mrank,trank);
9045: for ( ; s; s = NEXT(s) ) {
9046: e = getdeg(tv->v,(P)BDY(s));
9047: max = MAX(e,max);
9048: }
9049: } else {
9050: e = getdeg(tv->v,(P)BDY(t));
9051: max = MAX(e,max);
9052: }
9053: }
9054: nd_setup_parameters(nvar,max);
9055: obpe = nd_bpe; oadv = nmv_adv; oepos = nd_epos; ompos = nd_mpos;
9056: ishomo = 1;
9057: /* XXX */
9058: for ( in0 = 0, fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
9059: if ( nd_module ) {
9060: c = (pointer)pltondv(CO,vv,(LIST)BDY(t));
9061: } else {
9062: c = (pointer)ptondv(CO,vv,(P)BDY(t));
9063: }
9064: if ( ishomo )
9065: ishomo = ishomo && ndv_ishomo(c);
9066: if ( c ) {
9067: NEXTNODE(fd0,fd); BDY(fd) = (pointer)ndv_dup(0,c);
9068: ndv_mod(-2,c);
9069: NEXTNODE(in0,in); BDY(in) = (pointer)c;
9070: }
9071: }
9072: if ( in0 ) NEXT(in) = 0;
9073: if ( fd0 ) NEXT(fd) = 0;
9074: if ( !ishomo && homo ) {
9075: for ( t = in0, wmax = max; t; t = NEXT(t) ) {
9076: c = (NDV)BDY(t); len = LEN(c);
9077: for ( a = BDY(c), i = 0; i < len; i++, NMV_ADV(a) )
9078: wmax = MAX(TD(DL(a)),wmax);
9079: }
9080: homogenize_order(ord,nvar,&ord1);
9081: nd_init_ord(ord1);
9082: nd_setup_parameters(nvar+1,wmax);
9083: for ( t = fd0; t; t = NEXT(t) )
9084: ndv_homogenize((NDV)BDY(t),obpe,oadv,oepos,ompos);
9085: }
9086: if ( MaxDeg > 0 ) nocheck = 1;
9087: ret = ndv_setup(-2,m,fd0,nd_gbblock?1:0,0);
9088: if ( ret )
9089: cand = nd_f4_lf_trace_main(m,&perm);
9090: if ( !ret || !cand ) {
9091: *rp = 0; return;
9092: }
9093: if ( !ishomo && homo ) {
9094: /* dehomogenization */
9095: for ( t = cand; t; t = NEXT(t) ) ndv_dehomogenize((NDV)BDY(t),ord);
9096: nd_init_ord(ord);
9097: nd_setup_parameters(nvar,0);
9098: }
9099: cand = ndv_reducebase(cand,perm);
9100: cand = ndv_reduceall(-2,cand);
9101: cbpe = nd_bpe;
9102: get_eg(&eg0);
9103: if ( (ret = ndv_check_membership(-2,in0,obpe,oadv,oepos,cand)) != 0 ) {
9104: /* gbcheck : cand is a GB of Id(cand) ? */
9105: retn = nd_f4(-2,0,0);
9106: }
9107: if ( !retn ) {
9108: /* failure */
9109: *rp = 0; return;
9110: }
9111: get_eg(&eg1); init_eg(&eg_check); add_eg(&eg_check,&eg0,&eg1);
9112: if ( DP_Print )
1.5 noro 9113: fprintf(asir_out,"check=%.3fsec\n",eg_check.exectime);
1.1 noro 9114: /* dp->p */
9115: nd_bpe = cbpe;
9116: nd_setup_parameters(nd_nvar,0);
9117: for ( r = cand; r; r = NEXT(r) ) {
9118: if ( nd_module ) BDY(r) = ndvtopl(-2,CO,vv,BDY(r),mrank);
9119: else BDY(r) = (pointer)ndvtop(-2,CO,vv,BDY(r));
9120: }
9121: MKLIST(*rp,cand);
9122: }
9123:
9124: NODE nd_f4_lf_trace_main(int m,int **indp)
9125: {
9126: int i,nh,stat,index;
9127: NODE r,rm,g;
9128: ND_pairs d,l,l0,t;
9129: ND spol,red;
9130: NDV nf,redv,nfqv,nfv;
9131: NM s0,s;
9132: NODE rp0,srp0,nflist,nflist_lf;
9133: int nsp,nred,col,rank,len,k,j,a;
9134: UINT c;
9135: UINT **spmat;
9136: UINT *s0vect,*svect,*p,*v;
9137: int *colstat;
9138: IndArray *imat;
9139: int *rhead;
9140: int spcol,sprow;
9141: int sugar;
9142: PGeoBucket bucket;
9143: struct oEGT eg0,eg1,eg_f4;
9144:
9145: g = 0; d = 0;
9146: for ( i = 0; i < nd_psn; i++ ) {
9147: d = update_pairs(d,g,i,0);
9148: g = update_base(g,i);
9149: }
9150: while ( d ) {
9151: get_eg(&eg0);
9152: l = nd_minsugarp(d,&d);
9153: sugar = SG(l);
9154: if ( MaxDeg > 0 && sugar > MaxDeg ) break;
9155: bucket = create_pbucket();
9156: stat = nd_sp_f4(m,0,l,bucket);
9157: if ( !stat ) {
9158: for ( t = l; NEXT(t); t = NEXT(t) );
9159: NEXT(t) = d; d = l;
9160: d = nd_reconstruct(1,d);
9161: continue;
9162: }
9163: if ( bucket->m < 0 ) continue;
9164: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
9165: if ( !col ) {
9166: for ( t = l; NEXT(t); t = NEXT(t) );
9167: NEXT(t) = d; d = l;
9168: d = nd_reconstruct(1,d);
9169: continue;
9170: }
9171: get_eg(&eg1); init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg1);
9172: if ( DP_Print )
1.5 noro 9173: fprintf(asir_out,"\nsugar=%d,symb=%.3fsec,",sugar,eg_f4.exectime);
1.1 noro 9174: nflist = nd_f4_red(m,l,0,s0vect,col,rp0,&l0);
9175: if ( !l0 ) continue;
9176: l = l0;
9177:
9178: /* over LF */
9179: bucket = create_pbucket();
9180: stat = nd_sp_f4(-2,1,l,bucket);
9181: if ( !stat ) {
9182: for ( t = l; NEXT(t); t = NEXT(t) );
9183: NEXT(t) = d; d = l;
9184: d = nd_reconstruct(1,d);
9185: continue;
9186: }
9187: if ( bucket->m < 0 ) continue;
9188: col = nd_symbolic_preproc(bucket,1,&s0vect,&rp0);
9189: if ( !col ) {
9190: for ( t = l; NEXT(t); t = NEXT(t) );
9191: NEXT(t) = d; d = l;
9192: d = nd_reconstruct(1,d);
9193: continue;
9194: }
9195: nflist_lf = nd_f4_red(-2,l,1,s0vect,col,rp0,0);
9196: /* adding new bases */
9197: for ( rm = nflist, r = nflist_lf; r && rm; rm = NEXT(rm), r = NEXT(r) ) {
9198: nfv = (NDV)BDY(rm);
9199: nfqv = (NDV)BDY(r);
9200: if ( DL_COMPARE(HDL(nfv),HDL(nfqv)) ) return 0;
9201: ndv_removecont(m,nfv);
9202: ndv_removecont(-2,nfqv);
9203: nh = ndv_newps(-2,nfv,nfqv,1);
9204: d = update_pairs(d,g,nh,0);
9205: g = update_base(g,nh);
9206: }
9207: if ( r || rm ) return 0;
9208: }
9209: conv_ilist(nd_demand,1,g,indp);
9210: return g;
9211: }
9212:
1.7 noro 9213: #if SIZEOF_LONG==8
9214:
9215: NDV vect64_to_ndv(mp_limb_t *vect,int spcol,int col,int *rhead,UINT *s0vect)
9216: {
9217: int j,k,len;
9218: UINT *p;
9219: UINT c;
9220: NDV r;
9221: NMV mr0,mr;
9222:
9223: for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++;
9224: if ( !len ) return 0;
9225: else {
9226: mr0 = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
9227: #if 0
9228: ndv_alloc += nmv_adv*len;
9229: #endif
9230: mr = mr0;
9231: p = s0vect;
9232: for ( j = k = 0; j < col; j++, p += nd_wpd )
9233: if ( !rhead[j] ) {
9234: if ( (c = (UINT)vect[k++]) != 0 ) {
9235: ndl_copy(p,DL(mr)); CM(mr) = c; NMV_ADV(mr);
9236: }
9237: }
9238: MKNDV(nd_nvar,mr0,len,r);
9239: return r;
9240: }
9241: }
9242:
9243: int nd_to_vect64(int mod,UINT *s0,int n,ND d,mp_limb_t *r)
9244: {
9245: NM m;
1.11 noro 9246: UINT *t,*s,*u;
9247: int i,st,ed,md,prev,c;
1.7 noro 9248:
9249: for ( i = 0; i < n; i++ ) r[i] = 0;
1.11 noro 9250: prev = 0;
9251: for ( i = 0, m = BDY(d); m; m = NEXT(m) ) {
9252: t = DL(m);
9253: st = prev;
9254: ed = n;
9255: while ( ed > st ) {
9256: md = (st+ed)/2;
9257: u = s0+md*nd_wpd;
9258: c = DL_COMPARE(u,t);
9259: if ( c == 0 ) break;
9260: else if ( c > 0 ) st = md;
9261: else ed = md;
9262: }
9263: r[md] = (mp_limb_t)CM(m);
9264: prev = md;
1.7 noro 9265: }
9266: for ( i = 0; !r[i]; i++ );
9267: return i;
9268: }
9269:
9270: #define MOD128(a,c,m) ((a)=(((c)!=0||((a)>=(m)))?(((((U128)(c))<<64)+(a))%(m)):(a)))
9271:
9272: int ndv_reduce_vect64(int m,mp_limb_t *svect,mp_limb_t *cvect,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
9273: {
9274: int i,j,k,len,pos,prev;
9275: mp_limb_t a,c,c1,c2;
9276: IndArray ivect;
9277: unsigned char *ivc;
9278: unsigned short *ivs;
9279: unsigned int *ivi;
9280: NDV redv;
9281: NMV mr;
9282: NODE rp;
9283: int maxrs;
9284:
9285: for ( i = 0; i < col; i++ ) cvect[i] = 0;
9286: maxrs = 0;
9287: for ( i = 0; i < nred; i++ ) {
9288: ivect = imat[i];
9289: k = ivect->head;
9290: a = svect[k]; c = cvect[k];
9291: MOD128(a,c,m);
9292: svect[k] = a; cvect[k] = 0;
9293: if ( (c = svect[k]) != 0 ) {
1.11 noro 9294: Nf4_red++;
1.7 noro 9295: maxrs = MAX(maxrs,rp0[i]->sugar);
9296: c = m-c; redv = nd_ps[rp0[i]->index];
9297: len = LEN(redv); mr = BDY(redv);
9298: svect[k] = 0; prev = k;
9299: switch ( ivect->width ) {
9300: case 1:
9301: ivc = ivect->index.c;
9302: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
9303: pos = prev+ivc[j]; c1 = CM(mr); prev = pos;
1.12 noro 9304: c2 = svect[pos]+c1*c;
9305: if ( c2 < svect[pos] ) cvect[pos]++;
9306: svect[pos] = c2;
1.7 noro 9307: }
9308: break;
9309: case 2:
9310: ivs = ivect->index.s;
9311: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
9312: pos = prev+ivs[j]; c1 = CM(mr); prev = pos;
1.12 noro 9313: c2 = svect[pos]+c1*c;
9314: if ( c2 < svect[pos] ) cvect[pos]++;
9315: svect[pos] = c2;
1.7 noro 9316: }
9317: break;
9318: case 4:
9319: ivi = ivect->index.i;
9320: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
9321: pos = prev+ivi[j]; c1 = CM(mr); prev = pos;
1.12 noro 9322: c2 = svect[pos]+c1*c;
9323: if ( c2 < svect[pos] ) cvect[pos]++;
9324: svect[pos] = c2;
1.7 noro 9325: }
9326: break;
9327: }
9328: }
9329: }
9330: for ( i = 0; i < col; i++ ) {
9331: a = svect[i]; c = cvect[i]; MOD128(a,c,m); svect[i] = a;
9332: }
9333: return maxrs;
9334: }
9335:
9336: /* for Fp, 2^15=<p<2^29 */
9337:
9338: NODE nd_f4_red_mod64_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
9339: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz)
9340: {
9341: int spcol,sprow,a;
9342: int i,j,k,l,rank;
9343: NODE r0,r;
9344: ND_pairs sp;
9345: ND spol;
9346: mp_limb_t **spmat;
9347: mp_limb_t *svect,*cvect;
9348: mp_limb_t *v;
9349: int *colstat;
9350: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
9351: int maxrs;
9352: int *spsugar;
9353: ND_pairs *spactive;
9354:
9355: spcol = col-nred;
9356: get_eg(&eg0);
9357: /* elimination (1st step) */
9358: spmat = (mp_limb_t **)MALLOC(nsp*sizeof(mp_limb_t *));
9359: svect = (mp_limb_t *)MALLOC(col*sizeof(mp_limb_t));
9360: cvect = (mp_limb_t *)MALLOC(col*sizeof(mp_limb_t));
9361: spsugar = (int *)MALLOC(nsp*sizeof(int));
9362: spactive = !nz?0:(ND_pairs *)MALLOC(nsp*sizeof(ND_pairs));
9363: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
9364: nd_sp(m,0,sp,&spol);
9365: if ( !spol ) continue;
9366: nd_to_vect64(m,s0vect,col,spol,svect);
9367: maxrs = ndv_reduce_vect64(m,svect,cvect,col,imat,rvect,nred);
9368: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
9369: if ( i < col ) {
9370: spmat[sprow] = v = (mp_limb_t *)MALLOC_ATOMIC(spcol*sizeof(mp_limb_t));
9371: for ( j = k = 0; j < col; j++ )
9372: if ( !rhead[j] ) v[k++] = (UINT)svect[j];
9373: spsugar[sprow] = MAX(maxrs,SG(spol));
9374: if ( nz )
9375: spactive[sprow] = sp;
9376: sprow++;
9377: }
9378: nd_free(spol);
9379: }
1.12 noro 9380: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1); add_eg(&f4_elim1,&eg0,&eg1);
1.7 noro 9381: if ( DP_Print ) {
9382: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
9383: fflush(asir_out);
9384: }
9385: /* free index arrays */
9386: for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c);
9387:
9388: /* elimination (2nd step) */
9389: colstat = (int *)MALLOC(spcol*sizeof(int));
9390: rank = nd_gauss_elim_mod64(spmat,spsugar,spactive,sprow,spcol,m,colstat);
9391: r0 = 0;
9392: for ( i = 0; i < rank; i++ ) {
9393: NEXTNODE(r0,r); BDY(r) =
9394: (pointer)vect64_to_ndv(spmat[i],spcol,col,rhead,s0vect);
9395: SG((NDV)BDY(r)) = spsugar[i];
9396: GCFREE(spmat[i]);
9397: }
9398: if ( r0 ) NEXT(r) = 0;
9399:
9400: for ( ; i < sprow; i++ ) GCFREE(spmat[i]);
1.12 noro 9401: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2); add_eg(&f4_elim2,&eg1,&eg2);
1.7 noro 9402: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
9403: if ( DP_Print ) {
9404: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
9405: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
9406: nsp,nred,sprow,spcol,rank);
9407: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
9408: }
9409: if ( nz ) {
9410: for ( i = 0; i < rank-1; i++ ) NEXT(spactive[i]) = spactive[i+1];
9411: if ( rank > 0 ) {
9412: NEXT(spactive[rank-1]) = 0;
9413: *nz = spactive[0];
9414: } else
9415: *nz = 0;
9416: }
9417: return r0;
9418: }
9419:
9420: int nd_gauss_elim_mod64(mp_limb_t **mat,int *sugar,ND_pairs *spactive,int row,int col,int md,int *colstat)
9421: {
9422: int i,j,k,l,rank,s;
9423: mp_limb_t inv;
9424: mp_limb_t a;
9425: UINT c;
9426: mp_limb_t *t,*pivot,*pk;
9427: UINT *ck;
9428: UINT **cmat;
9429: UINT *ct;
9430: ND_pairs pair;
9431:
9432: cmat = (UINT **)MALLOC(row*sizeof(UINT *));
9433: for ( i = 0; i < row; i++ ) {
9434: cmat[i] = MALLOC_ATOMIC(col*sizeof(UINT));
9435: bzero(cmat[i],col*sizeof(UINT));
9436: }
9437:
9438: for ( rank = 0, j = 0; j < col; j++ ) {
9439: for ( i = rank; i < row; i++ ) {
9440: a = mat[i][j]; c = cmat[i][j];
9441: MOD128(a,c,md);
9442: mat[i][j] = a; cmat[i][j] = 0;
9443: }
9444: for ( i = rank; i < row; i++ )
9445: if ( mat[i][j] )
9446: break;
9447: if ( i == row ) {
9448: colstat[j] = 0;
9449: continue;
9450: } else
9451: colstat[j] = 1;
9452: if ( i != rank ) {
9453: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
9454: ct = cmat[i]; cmat[i] = cmat[rank]; cmat[rank] = ct;
9455: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
9456: if ( spactive ) {
9457: pair = spactive[i]; spactive[i] = spactive[rank];
9458: spactive[rank] = pair;
9459: }
9460: }
9461: /* column j is normalized */
9462: s = sugar[rank];
9463: inv = invm((UINT)mat[rank][j],md);
9464: /* normalize pivot row */
9465: for ( k = j, pk = mat[rank]+j, ck = cmat[rank]+j; k < col; k++, pk++, ck++ ) {
9466: a = *pk; c = *ck; MOD128(a,c,md); *pk = (a*inv)%md; *ck = 0;
9467: }
9468: for ( i = rank+1; i < row; i++ ) {
9469: if ( (a = mat[i][j]) != 0 ) {
9470: sugar[i] = MAX(sugar[i],s);
9471: red_by_vect64(md,mat[i]+j,cmat[i]+j,mat[rank]+j,(int)(md-a),col-j);
1.11 noro 9472: Nf4_red++;
1.7 noro 9473: }
9474: }
9475: rank++;
9476: }
9477: for ( j = col-1, l = rank-1; j >= 0; j-- )
9478: if ( colstat[j] ) {
9479: for ( k = j, pk = mat[l]+j, ck = cmat[l]+j; k < col; k++, pk++, ck++ ) {
9480: a = *pk; c = *ck; MOD128(a,c,md); *pk = a; *ck = 0;
9481: }
9482: s = sugar[l];
9483: for ( i = 0; i < l; i++ ) {
9484: a = mat[i][j]; c = cmat[i][j]; MOD128(a,c,md); mat[i][j] = a; cmat[i][j] = 0;
9485: if ( a ) {
9486: sugar[i] = MAX(sugar[i],s);
9487: red_by_vect64(md,mat[i]+j,cmat[i]+j,mat[l]+j,(int)(md-a),col-j);
1.11 noro 9488: Nf4_red++;
1.7 noro 9489: }
9490: }
9491: l--;
9492: }
9493: for ( i = 0; i < row; i++ ) GCFREE(cmat[i]);
9494: GCFREE(cmat);
9495: return rank;
9496: }
9497: #endif
9498:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to nd.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2018 / engine