Annotation of OpenXM_contrib2/asir2018/engine/nd.c, Revision 1.19
1.19 ! noro 1: /* $OpenXM: OpenXM_contrib2/asir2018/engine/nd.c,v 1.18 2019/09/04 01:12:02 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: }
481: if ( nd_module && current_module_weight_vector && MPOS(d) )
482: t += current_module_weight_vector[MPOS(d)];
483: return t;
484: }
485:
486: /* for sugarweight */
487:
488: int ndl_weight2(UINT *d)
489: {
490: int t,u;
491: int i,j;
492:
493: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
494: u = GET_EXP(d,i);
495: t += nd_sugarweight[i]*u;
496: }
497: if ( nd_module && current_module_weight_vector && MPOS(d) )
498: t += current_module_weight_vector[MPOS(d)];
499: return t;
500: }
501:
502: void ndl_weight_mask(UINT *d)
503: {
504: UINT t,u;
505: UINT *mask;
506: int i,j,k,l;
507:
508: l = nd_blockmask->n;
509: for ( k = 0; k < l; k++ ) {
510: mask = nd_blockmask->mask[k];
511: if ( current_dl_weight_vector )
512: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
513: u = GET_EXP_MASK(d,i,mask);
514: t += MUL_WEIGHT(u,i);
515: }
516: else
517: for ( t = 0, i = nd_exporigin; i < nd_wpd; i++ ) {
518: u = d[i]&mask[i];
519: for ( j = 0; j < nd_epw; j++, u>>=nd_bpe )
520: t += (u&nd_mask0);
521: }
522: d[k+1] = t;
523: }
524: }
525:
526: int ndl_lex_compare(UINT *d1,UINT *d2)
527: {
528: int i;
529:
530: d1 += nd_exporigin;
531: d2 += nd_exporigin;
532: for ( i = nd_exporigin; i < nd_wpd; i++, d1++, d2++ )
533: if ( *d1 > *d2 )
534: return nd_isrlex ? -1 : 1;
535: else if ( *d1 < *d2 )
536: return nd_isrlex ? 1 : -1;
537: return 0;
538: }
539:
540: int ndl_block_compare(UINT *d1,UINT *d2)
541: {
542: int i,l,j,ord_o,ord_l;
543: struct order_pair *op;
544: UINT t1,t2,m;
545: UINT *mask;
546:
547: l = nd_blockmask->n;
548: op = nd_blockmask->order_pair;
549: for ( j = 0; j < l; j++ ) {
550: mask = nd_blockmask->mask[j];
551: ord_o = op[j].order;
552: if ( ord_o < 2 ) {
553: if ( (t1=d1[j+1]) > (t2=d2[j+1]) ) return 1;
554: else if ( t1 < t2 ) return -1;
555: }
556: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
557: m = mask[i];
558: t1 = d1[i]&m;
559: t2 = d2[i]&m;
560: if ( t1 > t2 )
561: return !ord_o ? -1 : 1;
562: else if ( t1 < t2 )
563: return !ord_o ? 1 : -1;
564: }
565: }
566: return 0;
567: }
568:
569: int ndl_matrix_compare(UINT *d1,UINT *d2)
570: {
571: int i,j,s,row;
572: int *v;
573: Z **mat;
574: Z *w;
575: Z t1;
576: Z t,t2;
577:
1.6 noro 578: for ( j = 0; j < nd_nvar; j++ )
579: nd_work_vector[j] = GET_EXP(d1,j)-GET_EXP(d2,j);
1.1 noro 580: if ( nd_top_weight ) {
581: if ( OID(nd_top_weight) == O_VECT ) {
1.6 noro 582: mat = (Z **)&BDY((VECT)nd_top_weight);
583: row = 1;
1.1 noro 584: } else {
585: mat = (Z **)BDY((MAT)nd_top_weight);
1.6 noro 586: row = ((MAT)nd_top_weight)->row;
1.1 noro 587: }
588: for ( i = 0; i < row; i++ ) {
1.6 noro 589: w = mat[i];
1.1 noro 590: for ( j = 0, t = 0; j < nd_nvar; j++ ) {
1.6 noro 591: STOZ(nd_work_vector[j],t1);
1.1 noro 592: mulz(w[j],t1,&t2);
593: addz(t,t2,&t1);
594: t = t1;
595: }
1.6 noro 596: if ( t ) {
597: s = sgnz(t);
1.1 noro 598: if ( s > 0 ) return 1;
599: else if ( s < 0 ) return -1;
1.6 noro 600: }
1.1 noro 601: }
1.6 noro 602: }
603: for ( i = 0; i < nd_matrix_len; i++ ) {
604: v = nd_matrix[i];
605: for ( j = 0, s = 0; j < nd_nvar; j++ )
606: s += v[j]*nd_work_vector[j];
607: if ( s > 0 ) return 1;
608: else if ( s < 0 ) return -1;
609: }
1.1 noro 610: if ( !ndl_equal(d1,d2) )
1.6 noro 611: error("ndl_matrix_compare : invalid matrix");
612: return 0;
1.1 noro 613: }
614:
615: int ndl_composite_compare(UINT *d1,UINT *d2)
616: {
617: int i,j,s,start,end,len,o;
618: int *v;
619: struct sparse_weight *sw;
620:
621: for ( j = 0; j < nd_nvar; j++ )
622: nd_work_vector[j] = GET_EXP(d1,j)-GET_EXP(d2,j);
623: for ( i = 0; i < nd_worb_len; i++ ) {
624: len = nd_worb[i].length;
625: switch ( nd_worb[i].type ) {
626: case IS_DENSE_WEIGHT:
627: v = nd_worb[i].body.dense_weight;
628: for ( j = 0, s = 0; j < len; j++ )
629: s += v[j]*nd_work_vector[j];
630: if ( s > 0 ) return 1;
631: else if ( s < 0 ) return -1;
632: break;
633: case IS_SPARSE_WEIGHT:
634: sw = nd_worb[i].body.sparse_weight;
635: for ( j = 0, s = 0; j < len; j++ )
636: s += sw[j].value*nd_work_vector[sw[j].pos];
637: if ( s > 0 ) return 1;
638: else if ( s < 0 ) return -1;
639: break;
640: case IS_BLOCK:
641: o = nd_worb[i].body.block.order;
642: start = nd_worb[i].body.block.start;
643: switch ( o ) {
644: case 0:
645: end = start+len;
646: for ( j = start, s = 0; j < end; j++ )
647: s += MUL_WEIGHT(nd_work_vector[j],j);
648: if ( s > 0 ) return 1;
649: else if ( s < 0 ) return -1;
650: for ( j = end-1; j >= start; j-- )
651: if ( nd_work_vector[j] < 0 ) return 1;
652: else if ( nd_work_vector[j] > 0 ) return -1;
653: break;
654: case 1:
655: end = start+len;
656: for ( j = start, s = 0; j < end; j++ )
657: s += MUL_WEIGHT(nd_work_vector[j],j);
658: if ( s > 0 ) return 1;
659: else if ( s < 0 ) return -1;
660: for ( j = start; j < end; j++ )
661: if ( nd_work_vector[j] > 0 ) return 1;
662: else if ( nd_work_vector[j] < 0 ) return -1;
663: break;
664: case 2:
665: end = start+len;
666: for ( j = start; j < end; j++ )
667: if ( nd_work_vector[j] > 0 ) return 1;
668: else if ( nd_work_vector[j] < 0 ) return -1;
669: break;
670: }
671: break;
672: }
673: }
674: return 0;
675: }
676:
677: /* TDH -> WW -> TD-> RL */
678:
679: int ndl_ww_lex_compare(UINT *d1,UINT *d2)
680: {
681: int i,m,e1,e2;
682:
683: if ( TD(d1) > TD(d2) ) return 1;
684: else if ( TD(d1) < TD(d2) ) return -1;
685: m = nd_nvar>>1;
686: for ( i = 0, e1 = e2 = 0; i < m; i++ ) {
687: e1 += current_weyl_weight_vector[i]*(GET_EXP(d1,m+i)-GET_EXP(d1,i));
688: e2 += current_weyl_weight_vector[i]*(GET_EXP(d2,m+i)-GET_EXP(d2,i));
689: }
690: if ( e1 > e2 ) return 1;
691: else if ( e1 < e2 ) return -1;
692: return ndl_lex_compare(d1,d2);
693: }
694:
695: int ndl_module_weight_compare(UINT *d1,UINT *d2)
696: {
697: int s,j;
698:
699: if ( nd_nvar != nd_poly_weight_len )
700: error("invalid module weight : the length of polynomial weight != the number of variables");
701: s = 0;
702: for ( j = 0; j < nd_nvar; j++ )
703: s += (GET_EXP(d1,j)-GET_EXP(d2,j))*nd_poly_weight[j];
704: if ( MPOS(d1) >= 1 && MPOS(d2) >= 1 ) {
705: s += nd_module_weight[MPOS(d1)-1]-nd_module_weight[MPOS(d2)-1];
706: }
707: if ( s > 0 ) return 1;
708: else if ( s < 0 ) return -1;
709: else return 0;
710: }
711:
712: int ndl_module_grlex_compare(UINT *d1,UINT *d2)
713: {
714: int i,c;
715:
716: if ( nd_module_rank && (c = ndl_module_weight_compare(d1,d2)) ) return c;
717: if ( nd_ispot ) {
1.19 ! noro 718: if ( nd_pot_nelim && MPOS(d1)>=nd_pot_nelim+1 && MPOS(d2) >= nd_pot_nelim+1 ) {
! 719: if ( TD(d1) > TD(d2) ) return 1;
! 720: else if ( TD(d1) < TD(d2) ) return -1;
! 721: if ( (c = ndl_lex_compare(d1,d2)) != 0 ) return c;
! 722: if ( MPOS(d1) < MPOS(d2) ) return 1;
! 723: else if ( MPOS(d1) > MPOS(d2) ) return -1;
! 724: return 0;
! 725: }
! 726: if ( MPOS(d1) < MPOS(d2) ) return 1;
! 727: else if ( MPOS(d1) > MPOS(d2) ) return -1;
1.1 noro 728: }
729: if ( TD(d1) > TD(d2) ) return 1;
730: else if ( TD(d1) < TD(d2) ) return -1;
731: if ( (c = ndl_lex_compare(d1,d2)) != 0 ) return c;
732: if ( !nd_ispot ) {
733: if ( MPOS(d1) < MPOS(d2) ) return 1;
734: else if ( MPOS(d1) > MPOS(d2) ) return -1;
735: }
736: return 0;
737: }
738:
739: int ndl_module_glex_compare(UINT *d1,UINT *d2)
740: {
741: int i,c;
742:
743: if ( nd_module_rank && (c = ndl_module_weight_compare(d1,d2)) ) return c;
744: if ( nd_ispot ) {
745: if ( MPOS(d1) < MPOS(d2) ) return 1;
746: else if ( MPOS(d1) > MPOS(d2) ) return -1;
747: }
748: if ( TD(d1) > TD(d2) ) return 1;
749: else if ( TD(d1) < TD(d2) ) return -1;
750: if ( (c = ndl_lex_compare(d1,d2)) != 0 ) return c;
751: if ( !nd_ispot ) {
752: if ( MPOS(d1) < MPOS(d2) ) return 1;
753: else if ( MPOS(d1) > MPOS(d2) ) return -1;
754: }
755: return 0;
756: }
757:
758: int ndl_module_lex_compare(UINT *d1,UINT *d2)
759: {
760: int i,c;
761:
762: if ( nd_module_rank && (c = ndl_module_weight_compare(d1,d2)) ) return c;
763: if ( nd_ispot ) {
764: if ( MPOS(d1) < MPOS(d2) ) return 1;
765: else if ( MPOS(d1) > MPOS(d2) ) return -1;
766: }
767: if ( (c = ndl_lex_compare(d1,d2)) != 0 ) return c;
768: if ( !nd_ispot ) {
769: if ( MPOS(d1) < MPOS(d2) ) return 1;
770: else if ( MPOS(d1) > MPOS(d2) ) return -1;
771: }
772: return 0;
773: }
774:
775: int ndl_module_block_compare(UINT *d1,UINT *d2)
776: {
777: int i,c;
778:
779: if ( nd_module_rank && (c = ndl_module_weight_compare(d1,d2)) ) return c;
780: if ( nd_ispot ) {
781: if ( MPOS(d1) < MPOS(d2) ) return 1;
782: else if ( MPOS(d1) > MPOS(d2) ) return -1;
783: }
784: if ( (c = ndl_block_compare(d1,d2)) != 0 ) return c;
785: if ( !nd_ispot ) {
786: if ( MPOS(d1) < MPOS(d2) ) return 1;
787: else if ( MPOS(d1) > MPOS(d2) ) return -1;
788: }
789: return 0;
790: }
791:
792: int ndl_module_matrix_compare(UINT *d1,UINT *d2)
793: {
794: int i,c;
795:
796: if ( nd_module_rank && (c = ndl_module_weight_compare(d1,d2)) ) return c;
797: if ( nd_ispot ) {
798: if ( MPOS(d1) < MPOS(d2) ) return 1;
799: else if ( MPOS(d1) > MPOS(d2) ) return -1;
800: }
801: if ( (c = ndl_matrix_compare(d1,d2)) != 0 ) return c;
802: if ( !nd_ispot ) {
803: if ( MPOS(d1) < MPOS(d2) ) return 1;
804: else if ( MPOS(d1) > MPOS(d2) ) return -1;
805: }
806: return 0;
807: }
808:
809: int ndl_module_composite_compare(UINT *d1,UINT *d2)
810: {
811: int i,c;
812:
813: if ( nd_module_rank && (c = ndl_module_weight_compare(d1,d2)) ) return c;
814: if ( nd_ispot ) {
815: if ( MPOS(d1) > MPOS(d2) ) return 1;
816: else if ( MPOS(d1) < MPOS(d2) ) return -1;
817: }
818: if ( (c = ndl_composite_compare(d1,d2)) != 0 ) return c;
819: if ( !nd_ispot ) {
820: if ( MPOS(d1) > MPOS(d2) ) return 1;
821: else if ( MPOS(d1) < MPOS(d2) ) return -1;
822: }
823: return 0;
824: }
825:
826: INLINE int ndl_equal(UINT *d1,UINT *d2)
827: {
828: int i;
829:
830: switch ( nd_wpd ) {
831: case 2:
832: if ( TD(d2) != TD(d1) ) return 0;
833: if ( d2[1] != d1[1] ) return 0;
834: return 1;
835: break;
836: case 3:
837: if ( TD(d2) != TD(d1) ) return 0;
838: if ( d2[1] != d1[1] ) return 0;
839: if ( d2[2] != d1[2] ) return 0;
840: return 1;
841: break;
842: default:
843: for ( i = 0; i < nd_wpd; i++ )
844: if ( *d1++ != *d2++ ) return 0;
845: return 1;
846: break;
847: }
848: }
849:
850: INLINE void ndl_copy(UINT *d1,UINT *d2)
851: {
852: int i;
853:
854: switch ( nd_wpd ) {
855: case 2:
856: TD(d2) = TD(d1);
857: d2[1] = d1[1];
858: break;
859: case 3:
860: TD(d2) = TD(d1);
861: d2[1] = d1[1];
862: d2[2] = d1[2];
863: break;
864: default:
865: for ( i = 0; i < nd_wpd; i++ )
866: d2[i] = d1[i];
867: break;
868: }
869: }
870:
871: INLINE void ndl_zero(UINT *d)
872: {
873: int i;
874: for ( i = 0; i < nd_wpd; i++ ) d[i] = 0;
875: }
876:
877: INLINE void ndl_add(UINT *d1,UINT *d2,UINT *d)
878: {
879: int i;
880:
881: if ( nd_module ) {
882: if ( MPOS(d1) && MPOS(d2) && (MPOS(d1) != MPOS(d2)) )
883: error("ndl_add : invalid operation");
884: }
885: #if 1
886: switch ( nd_wpd ) {
887: case 2:
888: TD(d) = TD(d1)+TD(d2);
889: d[1] = d1[1]+d2[1];
890: break;
891: case 3:
892: TD(d) = TD(d1)+TD(d2);
893: d[1] = d1[1]+d2[1];
894: d[2] = d1[2]+d2[2];
895: break;
896: default:
897: for ( i = 0; i < nd_wpd; i++ ) d[i] = d1[i]+d2[i];
898: break;
899: }
900: #else
901: for ( i = 0; i < nd_wpd; i++ ) d[i] = d1[i]+d2[i];
902: #endif
903: }
904:
905: /* d1 += d2 */
906: INLINE void ndl_addto(UINT *d1,UINT *d2)
907: {
908: int i;
909:
910: if ( nd_module ) {
911: if ( MPOS(d1) && MPOS(d2) && (MPOS(d1) != MPOS(d2)) )
912: error("ndl_addto : invalid operation");
913: }
914: #if 1
915: switch ( nd_wpd ) {
916: case 2:
917: TD(d1) += TD(d2);
918: d1[1] += d2[1];
919: break;
920: case 3:
921: TD(d1) += TD(d2);
922: d1[1] += d2[1];
923: d1[2] += d2[2];
924: break;
925: default:
926: for ( i = 0; i < nd_wpd; i++ ) d1[i] += d2[i];
927: break;
928: }
929: #else
930: for ( i = 0; i < nd_wpd; i++ ) d1[i] += d2[i];
931: #endif
932: }
933:
934: INLINE void ndl_sub(UINT *d1,UINT *d2,UINT *d)
935: {
936: int i;
937:
938: for ( i = 0; i < nd_wpd; i++ ) d[i] = d1[i]-d2[i];
939: }
940:
941: int ndl_disjoint(UINT *d1,UINT *d2)
942: {
943: UINT t1,t2,u,u1,u2;
944: int i,j;
945:
946: if ( nd_module && (MPOS(d1) == MPOS(d2)) ) return 0;
947: #if USE_UNROLL
948: switch ( nd_bpe ) {
949: case 3:
950: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
951: u1 = d1[i]; u2 = d2[i];
952: t1 = u1&0x38000000; t2 = u2&0x38000000; if ( t1&&t2 ) return 0;
953: t1 = u1& 0x7000000; t2 = u2& 0x7000000; if ( t1&&t2 ) return 0;
954: t1 = u1& 0xe00000; t2 = u2& 0xe00000; if ( t1&&t2 ) return 0;
955: t1 = u1& 0x1c0000; t2 = u2& 0x1c0000; if ( t1&&t2 ) return 0;
956: t1 = u1& 0x38000; t2 = u2& 0x38000; if ( t1&&t2 ) return 0;
957: t1 = u1& 0x7000; t2 = u2& 0x7000; if ( t1&&t2 ) return 0;
958: t1 = u1& 0xe00; t2 = u2& 0xe00; if ( t1&&t2 ) return 0;
959: t1 = u1& 0x1c0; t2 = u2& 0x1c0; if ( t1&&t2 ) return 0;
960: t1 = u1& 0x38; t2 = u2& 0x38; if ( t1&&t2 ) return 0;
961: t1 = u1& 0x7; t2 = u2& 0x7; if ( t1&&t2 ) return 0;
962: }
963: return 1;
964: break;
965: case 4:
966: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
967: u1 = d1[i]; u2 = d2[i];
968: t1 = u1&0xf0000000; t2 = u2&0xf0000000; if ( t1&&t2 ) return 0;
969: t1 = u1& 0xf000000; t2 = u2& 0xf000000; if ( t1&&t2 ) return 0;
970: t1 = u1& 0xf00000; t2 = u2& 0xf00000; if ( t1&&t2 ) return 0;
971: t1 = u1& 0xf0000; t2 = u2& 0xf0000; if ( t1&&t2 ) return 0;
972: t1 = u1& 0xf000; t2 = u2& 0xf000; if ( t1&&t2 ) return 0;
973: t1 = u1& 0xf00; t2 = u2& 0xf00; if ( t1&&t2 ) return 0;
974: t1 = u1& 0xf0; t2 = u2& 0xf0; if ( t1&&t2 ) return 0;
975: t1 = u1& 0xf; t2 = u2& 0xf; if ( t1&&t2 ) return 0;
976: }
977: return 1;
978: break;
979: case 6:
980: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
981: u1 = d1[i]; u2 = d2[i];
982: t1 = u1&0x3f000000; t2 = u2&0x3f000000; if ( t1&&t2 ) return 0;
983: t1 = u1& 0xfc0000; t2 = u2& 0xfc0000; if ( t1&&t2 ) return 0;
984: t1 = u1& 0x3f000; t2 = u2& 0x3f000; if ( t1&&t2 ) return 0;
985: t1 = u1& 0xfc0; t2 = u2& 0xfc0; if ( t1&&t2 ) return 0;
986: t1 = u1& 0x3f; t2 = u2& 0x3f; if ( t1&&t2 ) return 0;
987: }
988: return 1;
989: break;
990: case 8:
991: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
992: u1 = d1[i]; u2 = d2[i];
993: t1 = u1&0xff000000; t2 = u2&0xff000000; if ( t1&&t2 ) return 0;
994: t1 = u1& 0xff0000; t2 = u2& 0xff0000; if ( t1&&t2 ) return 0;
995: t1 = u1& 0xff00; t2 = u2& 0xff00; if ( t1&&t2 ) return 0;
996: t1 = u1& 0xff; t2 = u2& 0xff; if ( t1&&t2 ) return 0;
997: }
998: return 1;
999: break;
1000: case 16:
1001: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1002: u1 = d1[i]; u2 = d2[i];
1003: t1 = u1&0xffff0000; t2 = u2&0xffff0000; if ( t1&&t2 ) return 0;
1004: t1 = u1& 0xffff; t2 = u2& 0xffff; if ( t1&&t2 ) return 0;
1005: }
1006: return 1;
1007: break;
1008: case 32:
1009: for ( i = nd_exporigin; i < nd_wpd; i++ )
1010: if ( d1[i] && d2[i] ) return 0;
1011: return 1;
1012: break;
1013: default:
1014: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1015: u1 = d1[i]; u2 = d2[i];
1016: for ( j = 0; j < nd_epw; j++ ) {
1017: if ( (u1&nd_mask0) && (u2&nd_mask0) ) return 0;
1018: u1 >>= nd_bpe; u2 >>= nd_bpe;
1019: }
1020: }
1021: return 1;
1022: break;
1023: }
1024: #else
1025: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1026: u1 = d1[i]; u2 = d2[i];
1027: for ( j = 0; j < nd_epw; j++ ) {
1028: if ( (u1&nd_mask0) && (u2&nd_mask0) ) return 0;
1029: u1 >>= nd_bpe; u2 >>= nd_bpe;
1030: }
1031: }
1032: return 1;
1033: #endif
1034: }
1035:
1036: int ndl_check_bound(UINT *d1,UINT *d2)
1037: {
1038: UINT u2;
1039: int i,j,ind,k;
1040:
1041: ind = 0;
1042: #if USE_UNROLL
1043: switch ( nd_bpe ) {
1044: case 3:
1045: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1046: u2 = d2[i];
1047: if ( d1[ind++]+((u2>>27)&0x7) >= 0x8 ) return 1;
1048: if ( d1[ind++]+((u2>>24)&0x7) >= 0x8 ) return 1;
1049: if ( d1[ind++]+((u2>>21)&0x7) >= 0x8 ) return 1;
1050: if ( d1[ind++]+((u2>>18)&0x7) >= 0x8 ) return 1;
1051: if ( d1[ind++]+((u2>>15)&0x7) >= 0x8 ) return 1;
1052: if ( d1[ind++]+((u2>>12)&0x7) >= 0x8 ) return 1;
1053: if ( d1[ind++]+((u2>>9)&0x7) >= 0x8 ) return 1;
1054: if ( d1[ind++]+((u2>>6)&0x7) >= 0x8 ) return 1;
1055: if ( d1[ind++]+((u2>>3)&0x7) >= 0x8 ) return 1;
1056: if ( d1[ind++]+(u2&0x7) >= 0x8 ) return 1;
1057: }
1058: return 0;
1059: break;
1060: case 4:
1061: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1062: u2 = d2[i];
1063: if ( d1[ind++]+((u2>>28)&0xf) >= 0x10 ) return 1;
1064: if ( d1[ind++]+((u2>>24)&0xf) >= 0x10 ) return 1;
1065: if ( d1[ind++]+((u2>>20)&0xf) >= 0x10 ) return 1;
1066: if ( d1[ind++]+((u2>>16)&0xf) >= 0x10 ) return 1;
1067: if ( d1[ind++]+((u2>>12)&0xf) >= 0x10 ) return 1;
1068: if ( d1[ind++]+((u2>>8)&0xf) >= 0x10 ) return 1;
1069: if ( d1[ind++]+((u2>>4)&0xf) >= 0x10 ) return 1;
1070: if ( d1[ind++]+(u2&0xf) >= 0x10 ) return 1;
1071: }
1072: return 0;
1073: break;
1074: case 6:
1075: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1076: u2 = d2[i];
1077: if ( d1[ind++]+((u2>>24)&0x3f) >= 0x40 ) return 1;
1078: if ( d1[ind++]+((u2>>18)&0x3f) >= 0x40 ) return 1;
1079: if ( d1[ind++]+((u2>>12)&0x3f) >= 0x40 ) return 1;
1080: if ( d1[ind++]+((u2>>6)&0x3f) >= 0x40 ) return 1;
1081: if ( d1[ind++]+(u2&0x3f) >= 0x40 ) return 1;
1082: }
1083: return 0;
1084: break;
1085: case 8:
1086: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1087: u2 = d2[i];
1088: if ( d1[ind++]+((u2>>24)&0xff) >= 0x100 ) return 1;
1089: if ( d1[ind++]+((u2>>16)&0xff) >= 0x100 ) return 1;
1090: if ( d1[ind++]+((u2>>8)&0xff) >= 0x100 ) return 1;
1091: if ( d1[ind++]+(u2&0xff) >= 0x100 ) return 1;
1092: }
1093: return 0;
1094: break;
1095: case 16:
1096: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1097: u2 = d2[i];
1098: if ( d1[ind++]+((u2>>16)&0xffff) > 0x10000 ) return 1;
1099: if ( d1[ind++]+(u2&0xffff) > 0x10000 ) return 1;
1100: }
1101: return 0;
1102: break;
1103: case 32:
1104: for ( i = nd_exporigin; i < nd_wpd; i++ )
1105: if ( d1[i]+d2[i]<d1[i] ) return 1;
1106: return 0;
1107: break;
1108: default:
1109: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1110: u2 = d2[i];
1111: k = (nd_epw-1)*nd_bpe;
1112: for ( j = 0; j < nd_epw; j++, k -= nd_bpe )
1113: if ( d1[ind++]+((u2>>k)&nd_mask0) > nd_mask0 ) return 1;
1114: }
1115: return 0;
1116: break;
1117: }
1118: #else
1119: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1120: u2 = d2[i];
1121: k = (nd_epw-1)*nd_bpe;
1122: for ( j = 0; j < nd_epw; j++, k -= nd_bpe )
1123: if ( d1[ind++]+((u2>>k)&nd_mask0) > nd_mask0 ) return 1;
1124: }
1125: return 0;
1126: #endif
1127: }
1128:
1129: int ndl_check_bound2(int index,UINT *d2)
1130: {
1131: return ndl_check_bound(nd_bound[index],d2);
1132: }
1133:
1134: INLINE int ndl_hash_value(UINT *d)
1135: {
1136: int i;
1.11 noro 1137: UINT r;
1.1 noro 1138:
1139: r = 0;
1140: for ( i = 0; i < nd_wpd; i++ )
1.12 noro 1141: r = (r*1511+d[i]);
1.11 noro 1142: r %= REDTAB_LEN;
1.1 noro 1143: return r;
1144: }
1145:
1146: INLINE int ndl_find_reducer(UINT *dg)
1147: {
1148: RHist r;
1149: int d,k,i;
1150:
1151: d = ndl_hash_value(dg);
1152: for ( r = nd_red[d], k = 0; r; r = NEXT(r), k++ ) {
1153: if ( ndl_equal(dg,DL(r)) ) {
1154: if ( k > 0 ) nd_notfirst++;
1155: nd_found++;
1156: return r->index;
1157: }
1158: }
1159: if ( Reverse )
1160: for ( i = nd_psn-1; i >= 0; i-- ) {
1161: r = nd_psh[i];
1162: if ( ndl_reducible(dg,DL(r)) ) {
1163: nd_create++;
1164: nd_append_red(dg,i);
1165: return i;
1166: }
1167: }
1168: else
1169: for ( i = 0; i < nd_psn; i++ ) {
1170: r = nd_psh[i];
1171: if ( ndl_reducible(dg,DL(r)) ) {
1172: nd_create++;
1173: nd_append_red(dg,i);
1174: return i;
1175: }
1176: }
1177: return -1;
1178: }
1179:
1180: ND nd_merge(ND p1,ND p2)
1181: {
1182: int n,c;
1183: int t,can,td1,td2;
1184: ND r;
1185: NM m1,m2,mr0,mr,s;
1186:
1187: if ( !p1 ) return p2;
1188: else if ( !p2 ) return p1;
1189: else {
1190: can = 0;
1191: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1192: c = DL_COMPARE(DL(m1),DL(m2));
1193: switch ( c ) {
1194: case 0:
1195: s = m1; m1 = NEXT(m1);
1196: can++; NEXTNM2(mr0,mr,s);
1197: s = m2; m2 = NEXT(m2); FREENM(s);
1198: break;
1199: case 1:
1200: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1201: break;
1202: case -1:
1203: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1204: break;
1205: }
1206: }
1207: if ( !mr0 )
1208: if ( m1 ) mr0 = m1;
1209: else if ( m2 ) mr0 = m2;
1210: else return 0;
1211: else if ( m1 ) NEXT(mr) = m1;
1212: else if ( m2 ) NEXT(mr) = m2;
1213: else NEXT(mr) = 0;
1214: BDY(p1) = mr0;
1215: SG(p1) = MAX(SG(p1),SG(p2));
1216: LEN(p1) = LEN(p1)+LEN(p2)-can;
1217: FREEND(p2);
1218: return p1;
1219: }
1220: }
1221:
1222: ND nd_add(int mod,ND p1,ND p2)
1223: {
1224: int n,c;
1225: int t,can,td1,td2;
1226: ND r;
1227: NM m1,m2,mr0,mr,s;
1228:
1.11 noro 1229: Nnd_add++;
1.1 noro 1230: if ( !p1 ) return p2;
1231: else if ( !p2 ) return p1;
1232: else if ( mod == -1 ) return nd_add_sf(p1,p2);
1233: else if ( mod == -2 ) return nd_add_lf(p1,p2);
1234: else if ( !mod ) return nd_add_q(p1,p2);
1235: else {
1236: can = 0;
1237: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1238: c = DL_COMPARE(DL(m1),DL(m2));
1239: switch ( c ) {
1240: case 0:
1241: t = ((CM(m1))+(CM(m2))) - mod;
1242: if ( t < 0 ) t += mod;
1243: s = m1; m1 = NEXT(m1);
1244: if ( t ) {
1245: can++; NEXTNM2(mr0,mr,s); CM(mr) = (t);
1246: } else {
1247: can += 2; FREENM(s);
1248: }
1249: s = m2; m2 = NEXT(m2); FREENM(s);
1250: break;
1251: case 1:
1252: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1253: break;
1254: case -1:
1255: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1256: break;
1257: }
1258: }
1259: if ( !mr0 )
1260: if ( m1 ) mr0 = m1;
1261: else if ( m2 ) mr0 = m2;
1262: else return 0;
1263: else if ( m1 ) NEXT(mr) = m1;
1264: else if ( m2 ) NEXT(mr) = m2;
1265: else NEXT(mr) = 0;
1266: BDY(p1) = mr0;
1267: SG(p1) = MAX(SG(p1),SG(p2));
1268: LEN(p1) = LEN(p1)+LEN(p2)-can;
1269: FREEND(p2);
1270: return p1;
1271: }
1272: }
1273:
1274: /* XXX on opteron, the inlined manipulation of destructive additon of
1275: * two NM seems to make gcc optimizer get confused, so the part is
1276: * done in a function.
1277: */
1278:
1279: int nm_destructive_add_q(NM *m1,NM *m2,NM *mr0,NM *mr)
1280: {
1281: NM s;
1282: P t;
1283: int can;
1284:
1285: addp(nd_vc,CP(*m1),CP(*m2),&t);
1286: s = *m1; *m1 = NEXT(*m1);
1287: if ( t ) {
1288: can = 1; NEXTNM2(*mr0,*mr,s); CP(*mr) = (t);
1289: } else {
1290: can = 2; FREENM(s);
1291: }
1292: s = *m2; *m2 = NEXT(*m2); FREENM(s);
1293: return can;
1294: }
1295:
1296: ND nd_add_q(ND p1,ND p2)
1297: {
1298: int n,c,can;
1299: ND r;
1300: NM m1,m2,mr0,mr,s;
1301: P t;
1302:
1303: if ( !p1 ) return p2;
1304: else if ( !p2 ) return p1;
1305: else {
1306: can = 0;
1307: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1308: c = DL_COMPARE(DL(m1),DL(m2));
1309: switch ( c ) {
1310: case 0:
1311: #if defined(__x86_64__)
1312: can += nm_destructive_add_q(&m1,&m2,&mr0,&mr);
1313: #else
1314: addp(nd_vc,CP(m1),CP(m2),&t);
1315: s = m1; m1 = NEXT(m1);
1316: if ( t ) {
1317: can++; NEXTNM2(mr0,mr,s); CP(mr) = (t);
1318: } else {
1319: can += 2; FREENM(s);
1320: }
1321: s = m2; m2 = NEXT(m2); FREENM(s);
1322: #endif
1323: break;
1324: case 1:
1325: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1326: break;
1327: case -1:
1328: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1329: break;
1330: }
1331: }
1332: if ( !mr0 )
1333: if ( m1 ) mr0 = m1;
1334: else if ( m2 ) mr0 = m2;
1335: else return 0;
1336: else if ( m1 ) NEXT(mr) = m1;
1337: else if ( m2 ) NEXT(mr) = m2;
1338: else NEXT(mr) = 0;
1339: BDY(p1) = mr0;
1340: SG(p1) = MAX(SG(p1),SG(p2));
1341: LEN(p1) = LEN(p1)+LEN(p2)-can;
1342: FREEND(p2);
1343: return p1;
1344: }
1345: }
1346:
1347: ND nd_add_sf(ND p1,ND p2)
1348: {
1349: int n,c,can;
1350: ND r;
1351: NM m1,m2,mr0,mr,s;
1352: int t;
1353:
1354: if ( !p1 ) return p2;
1355: else if ( !p2 ) return p1;
1356: else {
1357: can = 0;
1358: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1359: c = DL_COMPARE(DL(m1),DL(m2));
1360: switch ( c ) {
1361: case 0:
1362: t = _addsf(CM(m1),CM(m2));
1363: s = m1; m1 = NEXT(m1);
1364: if ( t ) {
1365: can++; NEXTNM2(mr0,mr,s); CM(mr) = (t);
1366: } else {
1367: can += 2; FREENM(s);
1368: }
1369: s = m2; m2 = NEXT(m2); FREENM(s);
1370: break;
1371: case 1:
1372: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1373: break;
1374: case -1:
1375: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1376: break;
1377: }
1378: }
1379: if ( !mr0 )
1380: if ( m1 ) mr0 = m1;
1381: else if ( m2 ) mr0 = m2;
1382: else return 0;
1383: else if ( m1 ) NEXT(mr) = m1;
1384: else if ( m2 ) NEXT(mr) = m2;
1385: else NEXT(mr) = 0;
1386: BDY(p1) = mr0;
1387: SG(p1) = MAX(SG(p1),SG(p2));
1388: LEN(p1) = LEN(p1)+LEN(p2)-can;
1389: FREEND(p2);
1390: return p1;
1391: }
1392: }
1393:
1394:
1395: ND nd_reduce2(int mod,ND d,ND g,NDV p,NM mul,NDC dn,Obj *divp)
1396: {
1397: int c,c1,c2;
1398: Z cg,cred,gcd,tq;
1399: P cgp,credp,gcdp;
1400: Obj tr,tr1;
1401:
1402: if ( mod == -1 ) {
1403: CM(mul) = _mulsf(_invsf(HCM(p)),_chsgnsf(HCM(g)));
1404: *divp = (Obj)ONE;
1405: } else if ( mod == -2 ) {
1406: Z inv,t;
1407: divlf(ONE,HCZ(p),&inv);
1408: chsgnlf(HCZ(g),&t);
1409: mullf(inv,t,&CZ(mul));
1410: *divp = (Obj)ONE;
1411: } else if ( mod ) {
1412: c1 = invm(HCM(p),mod); c2 = mod-HCM(g);
1413: DMAR(c1,c2,0,mod,c); CM(mul) = c;
1414: *divp = (Obj)ONE;
1415: } else if ( nd_vc ) {
1416: ezgcdpz(nd_vc,HCP(g),HCP(p),&gcdp);
1417: divsp(nd_vc,HCP(g),gcdp,&cgp); divsp(nd_vc,HCP(p),gcdp,&credp);
1418: chsgnp(cgp,&CP(mul));
1419: nd_mul_c_q(d,credp); nd_mul_c_q(g,credp);
1420: if ( dn ) {
1421: mulr(nd_vc,(Obj)dn->r,(Obj)credp,&tr);
1422: reductr(nd_vc,tr,&tr1); dn->r = (R)tr1;
1423: }
1424: *divp = (Obj)credp;
1425: } else {
1.6 noro 1426: igcd_cofactor(HCZ(g),HCZ(p),&gcd,&cg,&cred);
1427: chsgnz(cg,&CZ(mul));
1.1 noro 1428: nd_mul_c_q(d,(P)cred); nd_mul_c_q(g,(P)cred);
1429: if ( dn ) {
1430: mulz(dn->z,cred,&tq); dn->z = tq;
1431: }
1432: *divp = (Obj)cred;
1433: }
1434: return nd_add(mod,g,ndv_mul_nm(mod,mul,p));
1435: }
1436:
1437: /* ret=1 : success, ret=0 : overflow */
1.6 noro 1438: int nd_nf(int mod,ND d,ND g,NDV *ps,int full,ND *rp)
1.1 noro 1439: {
1440: NM m,mrd,tail;
1441: NM mul;
1442: int n,sugar,psugar,sugar0,stat,index;
1443: int c,c1,c2,dummy;
1444: RHist h;
1445: NDV p,red;
1446: Q cg,cred,gcd,tq,qq;
1447: Z iq;
1448: DP dmul;
1449: NODE node;
1450: LIST hist;
1451: double hmag;
1452: P tp,tp1;
1453: Obj tr,tr1,div;
1454: union oNDC hg;
1455: P cont;
1456:
1457: if ( !g ) {
1458: *rp = d;
1459: return 1;
1460: }
1461: if ( !mod ) hmag = ((double)p_mag(HCP(g)))*nd_scale;
1462:
1463: sugar0 = sugar = SG(g);
1464: n = NV(g);
1465: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
1466: if ( d )
1467: for ( tail = BDY(d); NEXT(tail); tail = NEXT(tail) );
1468: for ( ; g; ) {
1469: index = ndl_find_reducer(HDL(g));
1470: if ( index >= 0 ) {
1471: h = nd_psh[index];
1472: ndl_sub(HDL(g),DL(h),DL(mul));
1473: if ( ndl_check_bound2(index,DL(mul)) ) {
1474: nd_free(g); nd_free(d);
1475: return 0;
1476: }
1477: p = nd_demand ? ndv_load(index) : ps[index];
1478: /* d+g -> div*(d+g)+mul*p */
1.6 noro 1479: g = nd_reduce2(mod,d,g,p,mul,0,&div);
1.1 noro 1480: if ( nd_gentrace ) {
1481: /* Trace=[div,index,mul,ONE] */
1.6 noro 1482: STOZ(index,iq);
1.1 noro 1483: nmtodp(mod,mul,&dmul);
1484: node = mknode(4,div,iq,dmul,ONE);
1485: }
1486: sugar = MAX(sugar,SG(p)+TD(DL(mul)));
1487: if ( !mod && g && !nd_vc && ((double)(p_mag(HCP(g))) > hmag) ) {
1488: hg = HCU(g);
1489: nd_removecont2(d,g);
1.6 noro 1490: if ( nd_gentrace ) {
1.1 noro 1491: /* overwrite cont : Trace=[div,index,mul,cont] */
1.6 noro 1492: /* exact division */
1.1 noro 1493: cont = ndc_div(mod,hg,HCU(g));
1494: if ( nd_gentrace && !UNIQ(cont) ) ARG3(node) = (pointer)cont;
1495: }
1496: hmag = ((double)p_mag(HCP(g)))*nd_scale;
1497: }
1498: MKLIST(hist,node);
1499: MKNODE(node,hist,nd_tracelist); nd_tracelist = node;
1500: } else if ( !full ) {
1501: *rp = g;
1502: return 1;
1503: } else {
1504: m = BDY(g);
1505: if ( NEXT(m) ) {
1506: BDY(g) = NEXT(m); NEXT(m) = 0; LEN(g)--;
1507: } else {
1508: FREEND(g); g = 0;
1509: }
1510: if ( d ) {
1511: NEXT(tail)=m; tail=m; LEN(d)++;
1512: } else {
1513: MKND(n,m,1,d); tail = BDY(d);
1514: }
1515: }
1516: }
1517: if ( d ) SG(d) = sugar;
1518: *rp = d;
1519: return 1;
1520: }
1521:
1522: int nd_nf_pbucket(int mod,ND g,NDV *ps,int full,ND *rp)
1523: {
1524: int hindex,index;
1525: NDV p;
1526: ND u,d,red;
1527: NODE l;
1528: NM mul,m,mrd,tail;
1529: int sugar,psugar,n,h_reducible;
1530: PGeoBucket bucket;
1531: int c,c1,c2;
1532: Z cg,cred,gcd,zzz;
1533: RHist h;
1534: double hmag,gmag;
1535: int count = 0;
1536: int hcount = 0;
1537:
1538: if ( !g ) {
1539: *rp = 0;
1540: return 1;
1541: }
1542: sugar = SG(g);
1543: n = NV(g);
1.6 noro 1544: if ( !mod ) hmag = ((double)p_mag((P)HCZ(g)))*nd_scale;
1.1 noro 1545: bucket = create_pbucket();
1546: add_pbucket(mod,bucket,g);
1547: d = 0;
1548: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
1549: while ( 1 ) {
1550: if ( mod > 0 || mod == -1 )
1551: hindex = head_pbucket(mod,bucket);
1552: else if ( mod == -2 )
1553: hindex = head_pbucket_lf(bucket);
1554: else
1555: hindex = head_pbucket_q(bucket);
1556: if ( hindex < 0 ) {
1557: if ( DP_Print > 3 ) printf("(%d %d)",count,hcount);
1558: if ( d ) SG(d) = sugar;
1559: *rp = d;
1560: return 1;
1561: }
1562: g = bucket->body[hindex];
1563: index = ndl_find_reducer(HDL(g));
1564: if ( index >= 0 ) {
1565: count++;
1566: if ( !d ) hcount++;
1567: h = nd_psh[index];
1568: ndl_sub(HDL(g),DL(h),DL(mul));
1569: if ( ndl_check_bound2(index,DL(mul)) ) {
1570: nd_free(d);
1571: free_pbucket(bucket);
1572: *rp = 0;
1573: return 0;
1574: }
1575: p = ps[index];
1576: if ( mod == -1 )
1577: CM(mul) = _mulsf(_invsf(HCM(p)),_chsgnsf(HCM(g)));
1578: else if ( mod == -2 ) {
1579: Z inv,t;
1580: divlf(ONE,HCZ(p),&inv);
1581: chsgnlf(HCZ(g),&t);
1582: mullf(inv,t,&CZ(mul));
1583: } else if ( mod ) {
1584: c1 = invm(HCM(p),mod); c2 = mod-HCM(g);
1585: DMAR(c1,c2,0,mod,c); CM(mul) = c;
1586: } else {
1.6 noro 1587: igcd_cofactor(HCZ(g),HCZ(p),&gcd,&cg,&cred);
1588: chsgnz(cg,&CZ(mul));
1.1 noro 1589: nd_mul_c_q(d,(P)cred);
1590: mulq_pbucket(bucket,cred);
1591: g = bucket->body[hindex];
1.6 noro 1592: gmag = (double)p_mag((P)HCZ(g));
1.1 noro 1593: }
1594: red = ndv_mul_nm(mod,mul,p);
1595: bucket->body[hindex] = nd_remove_head(g);
1596: red = nd_remove_head(red);
1597: add_pbucket(mod,bucket,red);
1598: psugar = SG(p)+TD(DL(mul));
1599: sugar = MAX(sugar,psugar);
1600: if ( !mod && hmag && (gmag > hmag) ) {
1601: g = normalize_pbucket(mod,bucket);
1602: if ( !g ) {
1603: if ( d ) SG(d) = sugar;
1604: *rp = d;
1605: return 1;
1606: }
1607: nd_removecont2(d,g);
1.6 noro 1608: hmag = ((double)p_mag((P)HCZ(g)))*nd_scale;
1.1 noro 1609: add_pbucket(mod,bucket,g);
1610: }
1611: } else if ( !full ) {
1612: g = normalize_pbucket(mod,bucket);
1613: if ( g ) SG(g) = sugar;
1614: *rp = g;
1615: return 1;
1616: } else {
1617: m = BDY(g);
1618: if ( NEXT(m) ) {
1619: BDY(g) = NEXT(m); NEXT(m) = 0; LEN(g)--;
1620: } else {
1621: FREEND(g); g = 0;
1622: }
1623: bucket->body[hindex] = g;
1624: NEXT(m) = 0;
1625: if ( d ) {
1626: NEXT(tail)=m; tail=m; LEN(d)++;
1627: } else {
1628: MKND(n,m,1,d); tail = BDY(d);
1629: }
1630: }
1631: }
1632: }
1633:
1634: /* input : list of NDV, cand : list of NDV */
1635:
1636: int ndv_check_membership(int m,NODE input,int obpe,int oadv,EPOS oepos,NODE cand)
1637: {
1638: int n,i,stat;
1639: ND nf,d;
1640: NDV r;
1641: NODE t,s;
1642: union oNDC dn;
1643: Z q;
1644: LIST list;
1645:
1646: ndv_setup(m,0,cand,nd_gentrace?1:0,1);
1647: n = length(cand);
1648:
1649: if ( nd_gentrace ) { nd_alltracelist = 0; nd_tracelist = 0; }
1650: /* membercheck : list is a subset of Id(cand) ? */
1651: for ( t = input, i = 0; t; t = NEXT(t), i++ ) {
1652: again:
1653: nd_tracelist = 0;
1654: if ( nd_bpe > obpe )
1655: r = ndv_dup_realloc((NDV)BDY(t),obpe,oadv,oepos);
1656: else
1657: r = (NDV)BDY(t);
1658: #if 0
1659: // moved to nd_f4_lf_trace()
1660: if ( m == -2 ) ndv_mod(m,r);
1661: #endif
1662: d = ndvtond(m,r);
1.6 noro 1663: stat = nd_nf(m,0,d,nd_ps,0,&nf);
1.1 noro 1664: if ( !stat ) {
1665: nd_reconstruct(0,0);
1666: goto again;
1667: } else if ( nf ) return 0;
1668: if ( nd_gentrace ) {
1669: nd_tracelist = reverse_node(nd_tracelist);
1670: MKLIST(list,nd_tracelist);
1.6 noro 1671: STOZ(i,q); s = mknode(2,q,list); MKLIST(list,s);
1.1 noro 1672: MKNODE(s,list,nd_alltracelist);
1673: nd_alltracelist = s; nd_tracelist = 0;
1674: }
1675: if ( DP_Print ) { printf("."); fflush(stdout); }
1676: }
1677: if ( DP_Print ) { printf("\n"); }
1678: return 1;
1679: }
1680:
1681: ND nd_remove_head(ND p)
1682: {
1683: NM m;
1684:
1685: m = BDY(p);
1686: if ( !NEXT(m) ) {
1687: FREEND(p); p = 0;
1688: } else {
1689: BDY(p) = NEXT(m); LEN(p)--;
1690: }
1691: FREENM(m);
1692: return p;
1693: }
1694:
1695: ND nd_separate_head(ND p,ND *head)
1696: {
1697: NM m,m0;
1698: ND r;
1699:
1700: m = BDY(p);
1701: if ( !NEXT(m) ) {
1702: *head = p; p = 0;
1703: } else {
1704: m0 = m;
1705: BDY(p) = NEXT(m); LEN(p)--;
1706: NEXT(m0) = 0;
1707: MKND(NV(p),m0,1,r);
1708: *head = r;
1709: }
1710: return p;
1711: }
1712:
1713: PGeoBucket create_pbucket()
1714: {
1715: PGeoBucket g;
1716:
1717: g = CALLOC(1,sizeof(struct oPGeoBucket));
1718: g->m = -1;
1719: return g;
1720: }
1721:
1722: void free_pbucket(PGeoBucket b) {
1723: int i;
1724:
1725: for ( i = 0; i <= b->m; i++ )
1726: if ( b->body[i] ) {
1727: nd_free(b->body[i]);
1728: b->body[i] = 0;
1729: }
1730: GCFREE(b);
1731: }
1732:
1733: void add_pbucket_symbolic(PGeoBucket g,ND d)
1734: {
1735: int l,i,k,m;
1736:
1737: if ( !d )
1738: return;
1739: l = LEN(d);
1740: for ( k = 0, m = 1; l > m; k++, m <<= 1 );
1741: /* 2^(k-1) < l <= 2^k (=m) */
1742: d = nd_merge(g->body[k],d);
1743: for ( ; d && LEN(d) > m; k++, m <<= 1 ) {
1744: g->body[k] = 0;
1745: d = nd_merge(g->body[k+1],d);
1746: }
1747: g->body[k] = d;
1748: g->m = MAX(g->m,k);
1749: }
1750:
1751: void add_pbucket(int mod,PGeoBucket g,ND d)
1752: {
1753: int l,i,k,m;
1754:
1755: if ( !d )
1756: return;
1757: l = LEN(d);
1758: for ( k = 0, m = 1; l > m; k++, m <<= 1 );
1759: /* 2^(k-1) < l <= 2^k (=m) */
1760: d = nd_add(mod,g->body[k],d);
1761: for ( ; d && LEN(d) > m; k++, m <<= 1 ) {
1762: g->body[k] = 0;
1763: d = nd_add(mod,g->body[k+1],d);
1764: }
1765: g->body[k] = d;
1766: g->m = MAX(g->m,k);
1767: }
1768:
1769: void mulq_pbucket(PGeoBucket g,Z c)
1770: {
1771: int k;
1772:
1773: for ( k = 0; k <= g->m; k++ )
1774: nd_mul_c_q(g->body[k],(P)c);
1775: }
1776:
1777: NM remove_head_pbucket_symbolic(PGeoBucket g)
1778: {
1779: int j,i,k,c;
1780: NM head;
1781:
1782: k = g->m;
1783: j = -1;
1784: for ( i = 0; i <= k; i++ ) {
1785: if ( !g->body[i] ) continue;
1786: if ( j < 0 ) j = i;
1787: else {
1788: c = DL_COMPARE(HDL(g->body[i]),HDL(g->body[j]));
1789: if ( c > 0 )
1790: j = i;
1791: else if ( c == 0 )
1792: g->body[i] = nd_remove_head(g->body[i]);
1793: }
1794: }
1795: if ( j < 0 ) return 0;
1796: else {
1797: head = BDY(g->body[j]);
1798: if ( !NEXT(head) ) {
1799: FREEND(g->body[j]);
1800: g->body[j] = 0;
1801: } else {
1802: BDY(g->body[j]) = NEXT(head);
1803: LEN(g->body[j])--;
1804: }
1805: return head;
1806: }
1807: }
1808:
1809: int head_pbucket(int mod,PGeoBucket g)
1810: {
1811: int j,i,c,k,nv,sum;
1812: UINT *di,*dj;
1813: ND gi,gj;
1814:
1815: k = g->m;
1816: while ( 1 ) {
1817: j = -1;
1818: for ( i = 0; i <= k; i++ ) {
1819: if ( !(gi = g->body[i]) )
1820: continue;
1821: if ( j < 0 ) {
1822: j = i;
1823: gj = g->body[j];
1824: dj = HDL(gj);
1825: sum = HCM(gj);
1826: } else {
1827: c = DL_COMPARE(HDL(gi),dj);
1828: if ( c > 0 ) {
1829: if ( sum ) HCM(gj) = sum;
1830: else g->body[j] = nd_remove_head(gj);
1831: j = i;
1832: gj = g->body[j];
1833: dj = HDL(gj);
1834: sum = HCM(gj);
1835: } else if ( c == 0 ) {
1836: if ( mod == -1 )
1837: sum = _addsf(sum,HCM(gi));
1838: else {
1839: sum = sum+HCM(gi)-mod;
1840: if ( sum < 0 ) sum += mod;
1841: }
1842: g->body[i] = nd_remove_head(gi);
1843: }
1844: }
1845: }
1846: if ( j < 0 ) return -1;
1847: else if ( sum ) {
1848: HCM(gj) = sum;
1849: return j;
1850: } else
1851: g->body[j] = nd_remove_head(gj);
1852: }
1853: }
1854:
1855: int head_pbucket_q(PGeoBucket g)
1856: {
1857: int j,i,c,k,nv;
1858: Z sum,t;
1859: ND gi,gj;
1860:
1861: k = g->m;
1862: while ( 1 ) {
1863: j = -1;
1864: for ( i = 0; i <= k; i++ ) {
1865: if ( !(gi = g->body[i]) ) continue;
1866: if ( j < 0 ) {
1867: j = i;
1868: gj = g->body[j];
1.6 noro 1869: sum = HCZ(gj);
1.1 noro 1870: } else {
1871: nv = NV(gi);
1872: c = DL_COMPARE(HDL(gi),HDL(gj));
1873: if ( c > 0 ) {
1.6 noro 1874: if ( sum ) HCZ(gj) = sum;
1.1 noro 1875: else g->body[j] = nd_remove_head(gj);
1876: j = i;
1877: gj = g->body[j];
1.6 noro 1878: sum = HCZ(gj);
1.1 noro 1879: } else if ( c == 0 ) {
1.6 noro 1880: addz(sum,HCZ(gi),&t);
1.1 noro 1881: sum = t;
1882: g->body[i] = nd_remove_head(gi);
1883: }
1884: }
1885: }
1886: if ( j < 0 ) return -1;
1887: else if ( sum ) {
1.6 noro 1888: HCZ(gj) = sum;
1.1 noro 1889: return j;
1890: } else
1891: g->body[j] = nd_remove_head(gj);
1892: }
1893: }
1894:
1895: int head_pbucket_lf(PGeoBucket g)
1896: {
1897: int j,i,c,k,nv;
1898: Z sum,t;
1899: ND gi,gj;
1900:
1901: k = g->m;
1902: while ( 1 ) {
1903: j = -1;
1904: for ( i = 0; i <= k; i++ ) {
1905: if ( !(gi = g->body[i]) ) continue;
1906: if ( j < 0 ) {
1907: j = i;
1908: gj = g->body[j];
1909: sum = HCZ(gj);
1910: } else {
1911: nv = NV(gi);
1912: c = DL_COMPARE(HDL(gi),HDL(gj));
1913: if ( c > 0 ) {
1914: if ( sum ) HCZ(gj) = sum;
1915: else g->body[j] = nd_remove_head(gj);
1916: j = i;
1917: gj = g->body[j];
1918: sum = HCZ(gj);
1919: } else if ( c == 0 ) {
1920: addlf(sum,HCZ(gi),&t);
1921: sum = t;
1922: g->body[i] = nd_remove_head(gi);
1923: }
1924: }
1925: }
1926: if ( j < 0 ) return -1;
1927: else if ( sum ) {
1928: HCZ(gj) = sum;
1929: return j;
1930: } else
1931: g->body[j] = nd_remove_head(gj);
1932: }
1933: }
1934:
1935: ND normalize_pbucket(int mod,PGeoBucket g)
1936: {
1937: int i;
1938: ND r,t;
1939:
1940: r = 0;
1941: for ( i = 0; i <= g->m; i++ ) {
1942: r = nd_add(mod,r,g->body[i]);
1943: g->body[i] = 0;
1944: }
1945: g->m = -1;
1946: return r;
1947: }
1948:
1949: #if 0
1950: void register_hcf(NDV p)
1951: {
1952: DCP dc,t;
1953: P hc,h;
1954: int c;
1955: NODE l,l1,prev;
1956:
1957: hc = p->body->c.p;
1958: if ( !nd_vc || NUM(hc) ) return;
1959: fctrp(nd_vc,hc,&dc);
1960: for ( t = dc; t; t = NEXT(t) ) {
1961: h = t->c;
1962: if ( NUM(h) ) continue;
1963: for ( prev = 0, l = nd_hcf; l; prev = l, l = NEXT(l) ) {
1964: c = compp(nd_vc,h,(P)BDY(l));
1965: if ( c >= 0 ) break;
1966: }
1967: if ( !l || c > 0 ) {
1968: MKNODE(l1,h,l);
1969: if ( !prev )
1970: nd_hcf = l1;
1971: else
1972: NEXT(prev) = l1;
1973: }
1974: }
1975: }
1976: #else
1977: void register_hcf(NDV p)
1978: {
1979: DCP dc,t;
1980: P hc,h,q;
1981: Q dmy;
1982: int c;
1983: NODE l,l1,prev;
1984:
1985: hc = p->body->c.p;
1986: if ( NUM(hc) ) return;
1987: ptozp(hc,1,&dmy,&h);
1988: #if 1
1989: for ( l = nd_hcf; l; l = NEXT(l) ) {
1990: while ( 1 ) {
1991: if ( divtpz(nd_vc,h,(P)BDY(l),&q) ) h = q;
1992: else break;
1993: }
1994: }
1995: if ( NUM(h) ) return;
1996: #endif
1997: for ( prev = 0, l = nd_hcf; l; prev = l, l = NEXT(l) ) {
1998: c = compp(nd_vc,h,(P)BDY(l));
1999: if ( c >= 0 ) break;
2000: }
2001: if ( !l || c > 0 ) {
2002: MKNODE(l1,h,l);
2003: if ( !prev )
2004: nd_hcf = l1;
2005: else
2006: NEXT(prev) = l1;
2007: }
2008: }
2009: #endif
2010:
2011: int do_diagonalize(int sugar,int m)
2012: {
1.6 noro 2013: int i,nh,stat;
2014: NODE r,g,t;
2015: ND h,nf,s,head;
2016: NDV nfv;
2017: Q q;
2018: P nm,nmp,dn,mnp,dnp,cont,cont1;
2019: union oNDC hc;
2020: NODE node;
2021: LIST l;
2022: Z iq;
1.1 noro 2023:
1.6 noro 2024: for ( i = nd_psn-1; i >= 0 && SG(nd_psh[i]) == sugar; i-- ) {
2025: if ( nd_gentrace ) {
2026: /* Trace = [1,index,1,1] */
2027: STOZ(i,iq); node = mknode(4,ONE,iq,ONE,ONE);
2028: MKLIST(l,node); MKNODE(nd_tracelist,l,0);
2029: }
2030: if ( nd_demand )
2031: nfv = ndv_load(i);
2032: else
2033: nfv = nd_ps[i];
2034: s = ndvtond(m,nfv);
2035: s = nd_separate_head(s,&head);
2036: stat = nd_nf(m,head,s,nd_ps,1,&nf);
2037: if ( !stat ) return 0;
2038: ndv_free(nfv);
2039: hc = HCU(nf); nd_removecont(m,nf);
2040: /* exact division */
2041: cont = ndc_div(m,hc,HCU(nf));
1.1 noro 2042: if ( nd_gentrace ) finalize_tracelist(i,cont);
1.6 noro 2043: nfv = ndtondv(m,nf);
2044: nd_free(nf);
2045: nd_bound[i] = ndv_compute_bound(nfv);
2046: if ( !m ) register_hcf(nfv);
2047: if ( nd_demand ) {
2048: ndv_save(nfv,i);
2049: ndv_free(nfv);
2050: } else
2051: nd_ps[i] = nfv;
2052: }
2053: return 1;
1.1 noro 2054: }
2055:
2056: LIST compute_splist()
2057: {
2058: NODE g,tn0,tn,node;
2059: LIST l0;
2060: ND_pairs d,t;
2061: int i;
2062: Z i1,i2;
2063:
2064: g = 0; d = 0;
2065: for ( i = 0; i < nd_psn; i++ ) {
2066: d = update_pairs(d,g,i,0);
2067: g = update_base(g,i);
2068: }
2069: for ( t = d, tn0 = 0; t; t = NEXT(t) ) {
2070: NEXTNODE(tn0,tn);
1.6 noro 2071: STOZ(t->i1,i1); STOZ(t->i2,i2);
1.1 noro 2072: node = mknode(2,i1,i2); MKLIST(l0,node);
2073: BDY(tn) = l0;
2074: }
2075: if ( tn0 ) NEXT(tn) = 0; MKLIST(l0,tn0);
2076: return l0;
2077: }
2078:
2079: /* return value = 0 => input is not a GB */
2080:
2081: NODE nd_gb(int m,int ishomo,int checkonly,int gensyz,int **indp)
2082: {
1.6 noro 2083: int i,nh,sugar,stat;
2084: NODE r,g,t;
2085: ND_pairs d;
2086: ND_pairs l;
2087: ND h,nf,s,head,nf1;
2088: NDV nfv;
2089: Z q;
2090: union oNDC dn,hc;
2091: int diag_count = 0;
2092: P cont;
2093: LIST list;
2094:
1.11 noro 2095: Nnd_add = 0;
1.6 noro 2096: g = 0; d = 0;
2097: for ( i = 0; i < nd_psn; i++ ) {
2098: d = update_pairs(d,g,i,gensyz);
2099: g = update_base(g,i);
2100: }
2101: sugar = 0;
2102: while ( d ) {
1.1 noro 2103: again:
1.6 noro 2104: l = nd_minp(d,&d);
2105: if ( MaxDeg > 0 && SG(l) > MaxDeg ) break;
2106: if ( SG(l) != sugar ) {
2107: if ( ishomo ) {
2108: diag_count = 0;
2109: stat = do_diagonalize(sugar,m);
1.1 noro 2110: if ( !stat ) {
1.6 noro 2111: NEXT(l) = d; d = l;
2112: d = nd_reconstruct(0,d);
2113: goto again;
1.1 noro 2114: }
1.6 noro 2115: }
2116: sugar = SG(l);
2117: if ( DP_Print ) fprintf(asir_out,"%d",sugar);
2118: }
2119: stat = nd_sp(m,0,l,&h);
2120: if ( !stat ) {
2121: NEXT(l) = d; d = l;
2122: d = nd_reconstruct(0,d);
2123: goto again;
2124: }
1.1 noro 2125: #if USE_GEOBUCKET
1.6 noro 2126: stat = (m&&!nd_gentrace)?nd_nf_pbucket(m,h,nd_ps,!Top,&nf)
2127: :nd_nf(m,0,h,nd_ps,!Top,&nf);
1.1 noro 2128: #else
1.6 noro 2129: stat = nd_nf(m,0,h,nd_ps,!Top,&nf);
1.1 noro 2130: #endif
1.6 noro 2131: if ( !stat ) {
2132: NEXT(l) = d; d = l;
2133: d = nd_reconstruct(0,d);
2134: goto again;
2135: } else if ( nf ) {
2136: if ( checkonly || gensyz ) return 0;
1.1 noro 2137: if ( nd_newelim ) {
2138: if ( nd_module ) {
2139: if ( MPOS(HDL(nf)) > 1 ) return 0;
2140: } else if ( !(HDL(nf)[nd_exporigin] & nd_mask[0]) ) return 0;
2141: }
1.6 noro 2142: if ( DP_Print ) { printf("+"); fflush(stdout); }
2143: hc = HCU(nf);
2144: nd_removecont(m,nf);
2145: if ( !m && nd_nalg ) {
2146: nd_monic(0,&nf);
2147: nd_removecont(m,nf);
2148: }
2149: if ( nd_gentrace ) {
2150: /* exact division */
1.1 noro 2151: cont = ndc_div(m,hc,HCU(nf));
2152: if ( m || !UNIQ(cont) ) {
1.6 noro 2153: t = mknode(4,NULLP,NULLP,NULLP,cont);
2154: MKLIST(list,t); MKNODE(t,list,nd_tracelist);
1.1 noro 2155: nd_tracelist = t;
2156: }
2157: }
1.6 noro 2158: nfv = ndtondv(m,nf); nd_free(nf);
2159: nh = ndv_newps(m,nfv,0,0);
2160: if ( !m && (ishomo && ++diag_count == diag_period) ) {
2161: diag_count = 0;
2162: stat = do_diagonalize(sugar,m);
2163: if ( !stat ) {
2164: NEXT(l) = d; d = l;
2165: d = nd_reconstruct(1,d);
2166: goto again;
1.1 noro 2167: }
1.6 noro 2168: }
2169: d = update_pairs(d,g,nh,0);
2170: g = update_base(g,nh);
2171: FREENDP(l);
2172: } else {
2173: if ( nd_gentrace && gensyz ) {
2174: nd_tracelist = reverse_node(nd_tracelist);
2175: MKLIST(list,nd_tracelist);
2176: STOZ(-1,q); t = mknode(2,q,list); MKLIST(list,t);
2177: MKNODE(t,list,nd_alltracelist);
2178: nd_alltracelist = t; nd_tracelist = 0;
2179: }
2180: if ( DP_Print ) { printf("."); fflush(stdout); }
2181: FREENDP(l);
2182: }
2183: }
2184: conv_ilist(nd_demand,0,g,indp);
1.11 noro 2185: if ( !checkonly && DP_Print ) { printf("nd_gb done. Number of nd_add=%d\n",Nnd_add); fflush(stdout); }
1.1 noro 2186: return g;
2187: }
2188:
2189: /* splist = [[i1,i2],...] */
2190:
2191: int check_splist(int m,NODE splist)
2192: {
2193: NODE t,p;
2194: ND_pairs d,r,l;
2195: int stat;
2196: ND h,nf;
2197:
2198: for ( d = 0, t = splist; t; t = NEXT(t) ) {
2199: p = BDY((LIST)BDY(t));
1.6 noro 2200: NEXTND_pairs(d,r);
2201: r->i1 = ZTOS((Q)ARG0(p)); r->i2 = ZTOS((Q)ARG1(p));
2202: ndl_lcm(DL(nd_psh[r->i1]),DL(nd_psh[r->i2]),r->lcm);
1.1 noro 2203: SG(r) = TD(LCM(r)); /* XXX */
2204: }
2205: if ( d ) NEXT(r) = 0;
2206:
1.6 noro 2207: while ( d ) {
1.1 noro 2208: again:
1.6 noro 2209: l = nd_minp(d,&d);
2210: stat = nd_sp(m,0,l,&h);
2211: if ( !stat ) {
2212: NEXT(l) = d; d = l;
2213: d = nd_reconstruct(0,d);
2214: goto again;
2215: }
2216: stat = nd_nf(m,0,h,nd_ps,!Top,&nf);
2217: if ( !stat ) {
2218: NEXT(l) = d; d = l;
2219: d = nd_reconstruct(0,d);
2220: goto again;
2221: } else if ( nf ) return 0;
1.1 noro 2222: if ( DP_Print) { printf("."); fflush(stdout); }
1.6 noro 2223: }
1.1 noro 2224: if ( DP_Print) { printf("done.\n"); fflush(stdout); }
2225: return 1;
2226: }
2227:
2228: int check_splist_f4(int m,NODE splist)
2229: {
2230: UINT *s0vect;
1.6 noro 2231: PGeoBucket bucket;
1.1 noro 2232: NODE p,rp0,t;
2233: ND_pairs d,r,l,ll;
2234: int col,stat;
2235:
2236: for ( d = 0, t = splist; t; t = NEXT(t) ) {
2237: p = BDY((LIST)BDY(t));
1.6 noro 2238: NEXTND_pairs(d,r);
2239: r->i1 = ZTOS((Q)ARG0(p)); r->i2 = ZTOS((Q)ARG1(p));
2240: ndl_lcm(DL(nd_psh[r->i1]),DL(nd_psh[r->i2]),r->lcm);
1.1 noro 2241: SG(r) = TD(LCM(r)); /* XXX */
2242: }
2243: if ( d ) NEXT(r) = 0;
2244:
1.6 noro 2245: while ( d ) {
2246: l = nd_minsugarp(d,&d);
2247: bucket = create_pbucket();
2248: stat = nd_sp_f4(m,0,l,bucket);
2249: if ( !stat ) {
2250: for ( ll = l; NEXT(ll); ll = NEXT(ll) );
2251: NEXT(ll) = d; d = l;
2252: d = nd_reconstruct(0,d);
2253: continue;
2254: }
2255: if ( bucket->m < 0 ) continue;
2256: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
2257: if ( !col ) {
2258: for ( ll = l; NEXT(ll); ll = NEXT(ll) );
2259: NEXT(ll) = d; d = l;
2260: d = nd_reconstruct(0,d);
2261: continue;
1.1 noro 2262: }
1.6 noro 2263: if ( nd_f4_red(m,l,0,s0vect,col,rp0,0) ) return 0;
2264: }
2265: return 1;
1.1 noro 2266: }
2267:
2268: int do_diagonalize_trace(int sugar,int m)
2269: {
1.6 noro 2270: int i,nh,stat;
2271: NODE r,g,t;
2272: ND h,nf,nfq,s,head;
2273: NDV nfv,nfqv;
2274: Q q,den,num;
2275: union oNDC hc;
2276: NODE node;
2277: LIST l;
2278: Z iq;
2279: P cont,cont1;
1.1 noro 2280:
1.6 noro 2281: for ( i = nd_psn-1; i >= 0 && SG(nd_psh[i]) == sugar; i-- ) {
2282: if ( nd_gentrace ) {
2283: /* Trace = [1,index,1,1] */
2284: STOZ(i,iq); node = mknode(4,ONE,iq,ONE,ONE);
2285: MKLIST(l,node); MKNODE(nd_tracelist,l,0);
2286: }
2287: /* for nd_ps */
2288: s = ndvtond(m,nd_ps[i]);
2289: s = nd_separate_head(s,&head);
2290: stat = nd_nf_pbucket(m,s,nd_ps,1,&nf);
2291: if ( !stat ) return 0;
2292: nf = nd_add(m,head,nf);
2293: ndv_free(nd_ps[i]);
2294: nd_ps[i] = ndtondv(m,nf);
2295: nd_free(nf);
2296:
2297: /* for nd_ps_trace */
2298: if ( nd_demand )
2299: nfv = ndv_load(i);
2300: else
2301: nfv = nd_ps_trace[i];
2302: s = ndvtond(0,nfv);
2303: s = nd_separate_head(s,&head);
2304: stat = nd_nf(0,head,s,nd_ps_trace,1,&nf);
2305: if ( !stat ) return 0;
2306: ndv_free(nfv);
2307: hc = HCU(nf); nd_removecont(0,nf);
2308: /* exact division */
1.1 noro 2309: cont = ndc_div(0,hc,HCU(nf));
1.6 noro 2310: if ( nd_gentrace ) finalize_tracelist(i,cont);
2311: nfv = ndtondv(0,nf);
2312: nd_free(nf);
2313: nd_bound[i] = ndv_compute_bound(nfv);
2314: register_hcf(nfv);
2315: if ( nd_demand ) {
2316: ndv_save(nfv,i);
2317: ndv_free(nfv);
2318: } else
2319: nd_ps_trace[i] = nfv;
2320: }
2321: return 1;
1.1 noro 2322: }
2323:
2324: static struct oEGT eg_invdalg;
2325: struct oEGT eg_le;
2326:
2327: void nd_subst_vector(VL vl,P p,NODE subst,P *r)
2328: {
2329: NODE tn;
2330: P p1;
2331:
2332: for ( tn = subst; tn; tn = NEXT(NEXT(tn)) ) {
2333: substp(vl,p,BDY(tn),BDY(NEXT(tn)),&p1); p = p1;
2334: }
2335: *r = p;
2336: }
2337:
2338: NODE nd_gb_trace(int m,int ishomo,int **indp)
2339: {
1.6 noro 2340: int i,nh,sugar,stat;
2341: NODE r,g,t;
2342: ND_pairs d;
2343: ND_pairs l;
2344: ND h,nf,nfq,s,head;
2345: NDV nfv,nfqv;
2346: Z q,den,num;
2347: P hc;
2348: union oNDC dn,hnfq;
2349: struct oEGT eg_monic,egm0,egm1;
2350: int diag_count = 0;
2351: P cont;
2352: LIST list;
2353:
2354: init_eg(&eg_monic);
2355: init_eg(&eg_invdalg);
2356: init_eg(&eg_le);
2357: g = 0; d = 0;
2358: for ( i = 0; i < nd_psn; i++ ) {
2359: d = update_pairs(d,g,i,0);
2360: g = update_base(g,i);
2361: }
2362: sugar = 0;
2363: while ( d ) {
1.1 noro 2364: again:
1.6 noro 2365: l = nd_minp(d,&d);
2366: if ( MaxDeg > 0 && SG(l) > MaxDeg ) break;
2367: if ( SG(l) != sugar ) {
1.1 noro 2368: #if 1
1.6 noro 2369: if ( ishomo ) {
2370: if ( DP_Print > 2 ) fprintf(asir_out,"|");
2371: stat = do_diagonalize_trace(sugar,m);
2372: if ( DP_Print > 2 ) fprintf(asir_out,"|");
2373: diag_count = 0;
1.1 noro 2374: if ( !stat ) {
1.6 noro 2375: NEXT(l) = d; d = l;
2376: d = nd_reconstruct(1,d);
2377: goto again;
1.1 noro 2378: }
1.6 noro 2379: }
2380: #endif
2381: sugar = SG(l);
2382: if ( DP_Print ) fprintf(asir_out,"%d",sugar);
2383: }
2384: stat = nd_sp(m,0,l,&h);
2385: if ( !stat ) {
2386: NEXT(l) = d; d = l;
2387: d = nd_reconstruct(1,d);
2388: goto again;
2389: }
1.1 noro 2390: #if USE_GEOBUCKET
1.6 noro 2391: stat = nd_nf_pbucket(m,h,nd_ps,!Top,&nf);
1.1 noro 2392: #else
1.6 noro 2393: stat = nd_nf(m,0,h,nd_ps,!Top,&nf);
1.1 noro 2394: #endif
1.6 noro 2395: if ( !stat ) {
2396: NEXT(l) = d; d = l;
2397: d = nd_reconstruct(1,d);
2398: goto again;
2399: } else if ( nf ) {
2400: if ( nd_demand ) {
2401: nfqv = ndv_load(nd_psn);
2402: nfq = ndvtond(0,nfqv);
2403: } else
2404: nfq = 0;
2405: if ( !nfq ) {
2406: if ( !nd_sp(0,1,l,&h) || !nd_nf(0,0,h,nd_ps_trace,!Top,&nfq) ) {
2407: NEXT(l) = d; d = l;
2408: d = nd_reconstruct(1,d);
2409: goto again;
2410: }
2411: }
2412: if ( nfq ) {
2413: /* m|HC(nfq) => failure */
2414: if ( nd_vc ) {
2415: nd_subst_vector(nd_vc,HCP(nfq),nd_subst,&hc); q = (Z)hc;
2416: } else
2417: q = HCZ(nfq);
2418: if ( !remqi((Q)q,m) ) return 0;
2419:
2420: if ( DP_Print ) { printf("+"); fflush(stdout); }
2421: hnfq = HCU(nfq);
2422: if ( nd_nalg ) {
2423: /* m|DN(HC(nf)^(-1)) => failure */
2424: get_eg(&egm0);
2425: if ( !nd_monic(m,&nfq) ) return 0;
2426: get_eg(&egm1); add_eg(&eg_monic,&egm0,&egm1);
2427: nd_removecont(0,nfq); nfqv = ndtondv(0,nfq); nd_free(nfq);
2428: nfv = ndv_dup(0,nfqv); ndv_mod(m,nfv); nd_free(nf);
2429: } else {
2430: nd_removecont(0,nfq); nfqv = ndtondv(0,nfq); nd_free(nfq);
2431: nd_removecont(m,nf); nfv = ndtondv(m,nf); nd_free(nf);
2432: }
2433: if ( nd_gentrace ) {
2434: /* exact division */
2435: cont = ndc_div(0,hnfq,HCU(nfqv));
2436: if ( !UNIQ(cont) ) {
2437: t = mknode(4,NULLP,NULLP,NULLP,cont);
2438: MKLIST(list,t); MKNODE(t,list,nd_tracelist);
2439: nd_tracelist = t;
2440: }
2441: }
2442: nh = ndv_newps(0,nfv,nfqv,0);
2443: if ( ishomo && ++diag_count == diag_period ) {
2444: diag_count = 0;
2445: if ( DP_Print > 2 ) fprintf(asir_out,"|");
2446: stat = do_diagonalize_trace(sugar,m);
2447: if ( DP_Print > 2 ) fprintf(asir_out,"|");
2448: if ( !stat ) {
1.1 noro 2449: NEXT(l) = d; d = l;
2450: d = nd_reconstruct(1,d);
2451: goto again;
1.6 noro 2452: }
1.1 noro 2453: }
1.6 noro 2454: d = update_pairs(d,g,nh,0);
2455: g = update_base(g,nh);
2456: } else {
2457: if ( DP_Print ) { printf("*"); fflush(stdout); }
2458: }
2459: } else {
2460: if ( DP_Print ) { printf("."); fflush(stdout); }
1.1 noro 2461: }
1.6 noro 2462: FREENDP(l);
2463: }
2464: if ( nd_nalg ) {
2465: if ( DP_Print ) {
2466: print_eg("monic",&eg_monic);
2467: print_eg("invdalg",&eg_invdalg);
2468: print_eg("le",&eg_le);
1.1 noro 2469: }
1.6 noro 2470: }
1.1 noro 2471: conv_ilist(nd_demand,1,g,indp);
1.6 noro 2472: if ( DP_Print ) { printf("nd_gb_trace done.\n"); fflush(stdout); }
2473: return g;
1.1 noro 2474: }
2475:
2476: int ndv_compare(NDV *p1,NDV *p2)
2477: {
2478: return DL_COMPARE(HDL(*p1),HDL(*p2));
2479: }
2480:
2481: int ndv_compare_rev(NDV *p1,NDV *p2)
2482: {
2483: return -DL_COMPARE(HDL(*p1),HDL(*p2));
2484: }
2485:
2486: int ndvi_compare(NDVI p1,NDVI p2)
2487: {
2488: return DL_COMPARE(HDL(p1->p),HDL(p2->p));
2489: }
2490:
2491: int ndvi_compare_rev(NDVI p1,NDVI p2)
2492: {
2493: return -DL_COMPARE(HDL(p1->p),HDL(p2->p));
2494: }
2495:
2496: NODE ndv_reduceall(int m,NODE f)
2497: {
2498: int i,j,n,stat;
2499: ND nf,g,head;
2500: NODE t,a0,a;
2501: union oNDC dn;
2502: Q q,num,den;
2503: NODE node;
2504: LIST l;
2505: Z iq,jq;
2506: int *perm;
2507: union oNDC hc;
2508: P cont,cont1;
2509:
2510: if ( nd_nora ) return f;
2511: n = length(f);
2512: ndv_setup(m,0,f,0,1);
2513: perm = (int *)MALLOC(n*sizeof(int));
2514: if ( nd_gentrace ) {
2515: for ( t = nd_tracelist, i = 0; i < n; i++, t = NEXT(t) )
1.6 noro 2516: perm[i] = ZTOS((Q)ARG1(BDY((LIST)BDY(t))));
1.1 noro 2517: }
2518: for ( i = 0; i < n; ) {
2519: if ( nd_gentrace ) {
2520: /* Trace = [1,index,1,1] */
1.6 noro 2521: STOZ(i,iq); node = mknode(4,ONE,iq,ONE,ONE);
1.1 noro 2522: MKLIST(l,node); MKNODE(nd_tracelist,l,0);
2523: }
2524: g = ndvtond(m,nd_ps[i]);
2525: g = nd_separate_head(g,&head);
1.6 noro 2526: stat = nd_nf(m,head,g,nd_ps,1,&nf);
1.1 noro 2527: if ( !stat )
2528: nd_reconstruct(0,0);
2529: else {
2530: if ( DP_Print ) { printf("."); fflush(stdout); }
2531: ndv_free(nd_ps[i]);
2532: hc = HCU(nf); nd_removecont(m,nf);
2533: if ( nd_gentrace ) {
2534: for ( t = nd_tracelist; t; t = NEXT(t) ) {
1.6 noro 2535: jq = ARG1(BDY((LIST)BDY(t))); j = ZTOS(jq);
2536: STOZ(perm[j],jq); ARG1(BDY((LIST)BDY(t))) = jq;
1.1 noro 2537: }
1.6 noro 2538: /* exact division */
1.1 noro 2539: cont = ndc_div(m,hc,HCU(nf));
2540: finalize_tracelist(perm[i],cont);
2541: }
2542: nd_ps[i] = ndtondv(m,nf); nd_free(nf);
2543: nd_bound[i] = ndv_compute_bound(nd_ps[i]);
2544: i++;
2545: }
2546: }
2547: if ( DP_Print ) { printf("\n"); }
2548: for ( a0 = 0, i = 0; i < n; i++ ) {
2549: NEXTNODE(a0,a);
2550: if ( !nd_gentrace ) BDY(a) = (pointer)nd_ps[i];
2551: else {
2552: for ( j = 0; j < n; j++ ) if ( perm[j] == i ) break;
2553: BDY(a) = (pointer)nd_ps[j];
2554: }
2555: }
2556: NEXT(a) = 0;
2557: return a0;
2558: }
2559:
2560: ND_pairs update_pairs( ND_pairs d, NODE /* of index */ g, int t, int gensyz)
2561: {
2562: ND_pairs d1,nd,cur,head,prev,remove;
2563:
2564: if ( !g ) return d;
2565: /* for testing */
2566: if ( gensyz && nd_gensyz == 2 ) {
2567: d1 = nd_newpairs(g,t);
2568: if ( !d )
2569: return d1;
2570: else {
2571: nd = d;
2572: while ( NEXT(nd) ) nd = NEXT(nd);
2573: NEXT(nd) = d1;
2574: return d;
2575: }
2576: }
2577: d = crit_B(d,t);
2578: d1 = nd_newpairs(g,t);
2579: d1 = crit_M(d1);
2580: d1 = crit_F(d1);
2581: if ( gensyz || do_weyl )
2582: head = d1;
2583: else {
2584: prev = 0; cur = head = d1;
2585: while ( cur ) {
2586: if ( crit_2( cur->i1,cur->i2 ) ) {
2587: remove = cur;
2588: if ( !prev ) head = cur = NEXT(cur);
2589: else cur = NEXT(prev) = NEXT(cur);
2590: FREENDP(remove);
2591: } else {
2592: prev = cur; cur = NEXT(cur);
2593: }
2594: }
2595: }
2596: if ( !d )
2597: return head;
2598: else {
2599: nd = d;
2600: while ( NEXT(nd) ) nd = NEXT(nd);
2601: NEXT(nd) = head;
2602: return d;
2603: }
2604: }
2605:
2606:
2607: ND_pairs nd_newpairs( NODE g, int t )
2608: {
2609: NODE h;
2610: UINT *dl;
2611: int ts,s,i,t0,min,max;
2612: ND_pairs r,r0;
2613:
2614: dl = DL(nd_psh[t]);
2615: ts = SG(nd_psh[t]) - TD(dl);
1.17 noro 2616: if ( nd_module && nd_intersect && (MPOS(dl) > nd_intersect) ) return 0;
1.1 noro 2617: for ( r0 = 0, h = g; h; h = NEXT(h) ) {
2618: if ( nd_module && (MPOS(DL(nd_psh[(long)BDY(h)])) != MPOS(dl)) )
2619: continue;
2620: if ( nd_gbblock ) {
2621: t0 = (long)BDY(h);
2622: for ( i = 0; nd_gbblock[i] >= 0; i += 2 ) {
2623: min = nd_gbblock[i]; max = nd_gbblock[i+1];
2624: if ( t0 >= min && t0 <= max && t >= min && t <= max )
2625: break;
2626: }
2627: if ( nd_gbblock[i] >= 0 )
2628: continue;
2629: }
2630: NEXTND_pairs(r0,r);
2631: r->i1 = (long)BDY(h);
2632: r->i2 = t;
2633: ndl_lcm(DL(nd_psh[r->i1]),dl,r->lcm);
2634: s = SG(nd_psh[r->i1])-TD(DL(nd_psh[r->i1]));
2635: SG(r) = MAX(s,ts) + TD(LCM(r));
2636: /* experimental */
2637: if ( nd_sugarweight )
2638: r->sugar2 = ndl_weight2(r->lcm);
2639: }
2640: if ( r0 ) NEXT(r) = 0;
2641: return r0;
2642: }
2643:
2644: /* ipair = [i1,i2],[i1,i2],... */
2645: ND_pairs nd_ipairtospair(NODE ipair)
2646: {
2647: int s1,s2;
2648: NODE tn,t;
2649: ND_pairs r,r0;
2650:
2651: for ( r0 = 0, t = ipair; t; t = NEXT(t) ) {
2652: NEXTND_pairs(r0,r);
2653: tn = BDY((LIST)BDY(t));
1.6 noro 2654: r->i1 = ZTOS((Q)ARG0(tn));
2655: r->i2 = ZTOS((Q)ARG1(tn));
1.1 noro 2656: ndl_lcm(DL(nd_psh[r->i1]),DL(nd_psh[r->i2]),r->lcm);
2657: s1 = SG(nd_psh[r->i1])-TD(DL(nd_psh[r->i1]));
2658: s2 = SG(nd_psh[r->i2])-TD(DL(nd_psh[r->i2]));
2659: SG(r) = MAX(s1,s2) + TD(LCM(r));
2660: /* experimental */
2661: if ( nd_sugarweight )
2662: r->sugar2 = ndl_weight2(r->lcm);
2663: }
2664: if ( r0 ) NEXT(r) = 0;
2665: return r0;
2666: }
2667:
2668: /* kokokara */
2669:
2670: ND_pairs crit_B( ND_pairs d, int s )
2671: {
2672: ND_pairs cur,head,prev,remove;
2673: UINT *t,*tl,*lcm;
2674: int td,tdl;
2675:
2676: if ( !d ) return 0;
2677: t = DL(nd_psh[s]);
2678: prev = 0;
2679: head = cur = d;
2680: lcm = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
2681: while ( cur ) {
2682: tl = cur->lcm;
2683: if ( ndl_reducible(tl,t) ) {
2684: ndl_lcm(DL(nd_psh[cur->i1]),t,lcm);
2685: if ( !ndl_equal(lcm,tl) ) {
2686: ndl_lcm(DL(nd_psh[cur->i2]),t,lcm);
2687: if (!ndl_equal(lcm,tl)) {
2688: remove = cur;
2689: if ( !prev ) {
2690: head = cur = NEXT(cur);
2691: } else {
2692: cur = NEXT(prev) = NEXT(cur);
2693: }
2694: FREENDP(remove);
2695: } else {
2696: prev = cur; cur = NEXT(cur);
2697: }
2698: } else {
2699: prev = cur; cur = NEXT(cur);
2700: }
2701: } else {
2702: prev = cur; cur = NEXT(cur);
2703: }
2704: }
2705: return head;
2706: }
2707:
2708: ND_pairs crit_M( ND_pairs d1 )
2709: {
2710: ND_pairs e,d2,d3,dd,p;
2711: UINT *id,*jd;
2712:
2713: if ( !d1 ) return d1;
2714: for ( dd = 0, e = d1; e; e = d3 ) {
2715: if ( !(d2 = NEXT(e)) ) {
2716: NEXT(e) = dd;
2717: return e;
2718: }
2719: id = LCM(e);
2720: for ( d3 = 0; d2; d2 = p ) {
2721: p = NEXT(d2);
2722: jd = LCM(d2);
2723: if ( ndl_equal(jd,id) )
2724: ;
2725: else if ( TD(jd) > TD(id) )
2726: if ( ndl_reducible(jd,id) ) continue;
2727: else ;
2728: else if ( ndl_reducible(id,jd) ) goto delit;
2729: NEXT(d2) = d3;
2730: d3 = d2;
2731: }
2732: NEXT(e) = dd;
2733: dd = e;
2734: continue;
2735: /**/
2736: delit: NEXT(d2) = d3;
2737: d3 = d2;
2738: for ( ; p; p = d2 ) {
2739: d2 = NEXT(p);
2740: NEXT(p) = d3;
2741: d3 = p;
2742: }
2743: FREENDP(e);
2744: }
2745: return dd;
2746: }
2747:
2748: ND_pairs crit_F( ND_pairs d1 )
2749: {
2750: ND_pairs rest, head,remove;
2751: ND_pairs last, p, r, w;
2752: int s;
2753:
2754: if ( !d1 ) return d1;
2755: for ( head = last = 0, p = d1; NEXT(p); ) {
2756: r = w = equivalent_pairs(p,&rest);
2757: s = SG(r);
2758: w = NEXT(w);
2759: while ( w ) {
2760: if ( crit_2(w->i1,w->i2) ) {
2761: r = w;
2762: w = NEXT(w);
2763: while ( w ) {
2764: remove = w;
2765: w = NEXT(w);
2766: FREENDP(remove);
2767: }
2768: break;
2769: } else if ( SG(w) < s ) {
2770: FREENDP(r);
2771: r = w;
2772: s = SG(r);
2773: w = NEXT(w);
2774: } else {
2775: remove = w;
2776: w = NEXT(w);
2777: FREENDP(remove);
2778: }
2779: }
2780: if ( last ) NEXT(last) = r;
2781: else head = r;
2782: NEXT(last = r) = 0;
2783: p = rest;
2784: if ( !p ) return head;
2785: }
2786: if ( !last ) return p;
2787: NEXT(last) = p;
2788: return head;
2789: }
2790:
2791: int crit_2( int dp1, int dp2 )
2792: {
2793: return ndl_disjoint(DL(nd_psh[dp1]),DL(nd_psh[dp2]));
2794: }
2795:
2796: ND_pairs equivalent_pairs( ND_pairs d1, ND_pairs *prest )
2797: {
2798: ND_pairs w,p,r,s;
2799: UINT *d;
2800:
2801: w = d1;
2802: d = LCM(w);
2803: s = NEXT(w);
2804: NEXT(w) = 0;
2805: for ( r = 0; s; s = p ) {
2806: p = NEXT(s);
2807: if ( ndl_equal(d,LCM(s)) ) {
2808: NEXT(s) = w; w = s;
2809: } else {
2810: NEXT(s) = r; r = s;
2811: }
2812: }
2813: *prest = r;
2814: return w;
2815: }
2816:
2817: NODE update_base(NODE nd,int ndp)
2818: {
2819: UINT *dl, *dln;
2820: NODE last, p, head;
2821:
2822: dl = DL(nd_psh[ndp]);
2823: for ( head = last = 0, p = nd; p; ) {
2824: dln = DL(nd_psh[(long)BDY(p)]);
2825: if ( ndl_reducible( dln, dl ) ) {
2826: p = NEXT(p);
2827: if ( last ) NEXT(last) = p;
2828: } else {
2829: if ( !last ) head = p;
2830: p = NEXT(last = p);
2831: }
2832: }
2833: head = append_one(head,ndp);
2834: return head;
2835: }
2836:
2837: ND_pairs nd_minp( ND_pairs d, ND_pairs *prest )
2838: {
2839: ND_pairs m,ml,p,l;
2840: UINT *lcm;
2841: int s,td,len,tlen,c,c1;
2842:
2843: if ( !(p = NEXT(m = d)) ) {
2844: *prest = p;
2845: NEXT(m) = 0;
2846: return m;
2847: }
2848: if ( !NoSugar ) {
2849: if ( nd_sugarweight ) {
2850: s = m->sugar2;
2851: for ( ml = 0, l = m; p; p = NEXT(l = p) )
2852: if ( (p->sugar2 < s)
2853: || ((p->sugar2 == s) && (DL_COMPARE(LCM(p),LCM(m)) < 0)) ) {
2854: ml = l; m = p; s = m->sugar2;
2855: }
2856: } else {
2857: s = SG(m);
2858: for ( ml = 0, l = m; p; p = NEXT(l = p) )
2859: if ( (SG(p) < s)
2860: || ((SG(p) == s) && (DL_COMPARE(LCM(p),LCM(m)) < 0)) ) {
2861: ml = l; m = p; s = SG(m);
2862: }
2863: }
2864: } else {
2865: for ( ml = 0, l = m; p; p = NEXT(l = p) )
2866: if ( DL_COMPARE(LCM(p),LCM(m)) < 0 ) {
2867: ml = l; m = p; s = SG(m);
2868: }
2869: }
2870: if ( !ml ) *prest = NEXT(m);
2871: else {
2872: NEXT(ml) = NEXT(m);
2873: *prest = d;
2874: }
2875: NEXT(m) = 0;
2876: return m;
2877: }
2878:
2879: ND_pairs nd_minsugarp( ND_pairs d, ND_pairs *prest )
2880: {
2881: int msugar,i;
2882: ND_pairs t,dm0,dm,dr0,dr;
2883:
2884: if ( nd_sugarweight ) {
2885: for ( msugar = d->sugar2, t = NEXT(d); t; t = NEXT(t) )
2886: if ( t->sugar2 < msugar ) msugar = t->sugar2;
2887: dm0 = 0; dr0 = 0;
2888: for ( i = 0, t = d; t; t = NEXT(t) )
2889: if ( i < nd_f4_nsp && t->sugar2 == msugar ) {
2890: if ( dm0 ) NEXT(dm) = t;
2891: else dm0 = t;
2892: dm = t;
2893: i++;
2894: } else {
2895: if ( dr0 ) NEXT(dr) = t;
2896: else dr0 = t;
2897: dr = t;
2898: }
2899: } else {
2900: for ( msugar = SG(d), t = NEXT(d); t; t = NEXT(t) )
2901: if ( SG(t) < msugar ) msugar = SG(t);
2902: dm0 = 0; dr0 = 0;
2903: for ( i = 0, t = d; t; t = NEXT(t) )
2904: if ( i < nd_f4_nsp && SG(t) == msugar ) {
2905: if ( dm0 ) NEXT(dm) = t;
2906: else dm0 = t;
2907: dm = t;
2908: i++;
2909: } else {
2910: if ( dr0 ) NEXT(dr) = t;
2911: else dr0 = t;
2912: dr = t;
2913: }
2914: }
2915: NEXT(dm) = 0;
2916: if ( dr0 ) NEXT(dr) = 0;
2917: *prest = dr0;
2918: return dm0;
2919: }
2920:
2921: int nd_tdeg(NDV c)
2922: {
2923: int wmax = 0;
2924: int i,len;
2925: NMV a;
2926:
2927: len = LEN(c);
2928: for ( a = BDY(c), i = 0; i < len; i++, NMV_ADV(a) )
2929: wmax = MAX(TD(DL(a)),wmax);
2930: return wmax;
2931: }
2932:
2933: int ndv_newps(int m,NDV a,NDV aq,int f4)
2934: {
2935: int len;
2936: RHist r;
2937: NDV b;
2938: NODE tn;
2939: LIST l;
2940: Z iq;
2941:
2942: if ( nd_psn == nd_pslen ) {
2943: nd_pslen *= 2;
2944: nd_ps = (NDV *)REALLOC((char *)nd_ps,nd_pslen*sizeof(NDV));
2945: nd_ps_trace = (NDV *)REALLOC((char *)nd_ps_trace,nd_pslen*sizeof(NDV));
2946: nd_psh = (RHist *)REALLOC((char *)nd_psh,nd_pslen*sizeof(RHist));
2947: nd_bound = (UINT **)
2948: REALLOC((char *)nd_bound,nd_pslen*sizeof(UINT *));
2949: nd_ps_sym = (NDV *)REALLOC((char *)nd_ps_sym,nd_pslen*sizeof(NDV));
2950: nd_ps_trace_sym = (NDV *)REALLOC((char *)nd_ps_trace_sym,nd_pslen*sizeof(NDV));
2951: }
2952: NEWRHist(r); nd_psh[nd_psn] = r;
2953: nd_ps[nd_psn] = a;
2954: if ( aq ) {
2955: nd_ps_trace[nd_psn] = aq;
2956: if ( !m ) {
2957: register_hcf(aq);
2958: } else if ( m == -2 ) {
2959: /* do nothing */
2960: } else
2961: error("ndv_newps : invalud modulus");
2962: nd_bound[nd_psn] = ndv_compute_bound(aq);
2963: #if 1
2964: SG(r) = SG(aq);
2965: #else
2966: SG(r) = nd_tdeg(aq);
2967: #endif
2968: ndl_copy(HDL(aq),DL(r));
2969: } else {
2970: if ( !m ) register_hcf(a);
2971: nd_bound[nd_psn] = ndv_compute_bound(a);
2972: #if 1
2973: SG(r) = SG(a);
2974: #else
2975: SG(r) = nd_tdeg(a);
2976: #endif
2977: ndl_copy(HDL(a),DL(r));
2978: }
2979: if ( nd_demand ) {
2980: if ( aq ) {
2981: ndv_save(nd_ps_trace[nd_psn],nd_psn);
2982: nd_ps_sym[nd_psn] = ndv_symbolic(m,nd_ps_trace[nd_psn]);
2983: nd_ps_trace_sym[nd_psn] = ndv_symbolic(m,nd_ps_trace[nd_psn]);
2984: nd_ps_trace[nd_psn] = 0;
2985: } else {
2986: ndv_save(nd_ps[nd_psn],nd_psn);
2987: nd_ps_sym[nd_psn] = ndv_symbolic(m,nd_ps[nd_psn]);
2988: nd_ps[nd_psn] = 0;
2989: }
2990: }
2991: if ( nd_gentrace ) {
2992: /* reverse the tracelist and append it to alltracelist */
2993: nd_tracelist = reverse_node(nd_tracelist); MKLIST(l,nd_tracelist);
1.6 noro 2994: STOZ(nd_psn,iq); tn = mknode(2,iq,l); MKLIST(l,tn);
1.1 noro 2995: MKNODE(tn,l,nd_alltracelist); nd_alltracelist = tn; nd_tracelist = 0;
2996: }
2997: return nd_psn++;
2998: }
2999:
3000: /* nd_tracelist = [[0,index,div],...,[nd_psn-1,index,div]] */
3001: /* return 1 if success, 0 if failure (HC(a mod p)) */
3002:
3003: int ndv_setup(int mod,int trace,NODE f,int dont_sort,int dont_removecont)
3004: {
1.6 noro 3005: int i,j,td,len,max;
3006: NODE s,s0,f0,tn;
3007: UINT *d;
3008: RHist r;
3009: NDVI w;
3010: NDV a,am;
3011: union oNDC hc;
3012: NODE node;
3013: P hcp;
3014: Z iq,jq;
3015: LIST l;
3016:
3017: nd_found = 0; nd_notfirst = 0; nd_create = 0;
3018: /* initialize the tracelist */
3019: nd_tracelist = 0;
3020:
3021: for ( nd_psn = 0, s = f; s; s = NEXT(s) ) if ( BDY(s) ) nd_psn++;
3022: w = (NDVI)MALLOC(nd_psn*sizeof(struct oNDVI));
3023: for ( i = j = 0, s = f; s; s = NEXT(s), j++ )
3024: if ( BDY(s) ) { w[i].p = BDY(s); w[i].i = j; i++; }
3025: if ( !dont_sort ) {
3026: /* XXX heuristic */
3027: if ( !nd_ord->id && (nd_ord->ord.simple<2) )
3028: qsort(w,nd_psn,sizeof(struct oNDVI),
3029: (int (*)(const void *,const void *))ndvi_compare_rev);
3030: else
3031: qsort(w,nd_psn,sizeof(struct oNDVI),
3032: (int (*)(const void *,const void *))ndvi_compare);
3033: }
3034: nd_pslen = 2*nd_psn;
3035: nd_ps = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3036: nd_ps_trace = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3037: nd_ps_sym = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3038: nd_ps_trace_sym = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3039: nd_psh = (RHist *)MALLOC(nd_pslen*sizeof(RHist));
3040: nd_bound = (UINT **)MALLOC(nd_pslen*sizeof(UINT *));
3041: nd_hcf = 0;
1.1 noro 3042:
1.6 noro 3043: if ( trace && nd_vc )
3044: makesubst(nd_vc,&nd_subst);
3045: else
3046: nd_subst = 0;
1.1 noro 3047:
1.6 noro 3048: if ( !nd_red )
3049: nd_red = (RHist *)MALLOC(REDTAB_LEN*sizeof(RHist));
3050: for ( i = 0; i < REDTAB_LEN; i++ ) nd_red[i] = 0;
3051: for ( i = 0; i < nd_psn; i++ ) {
3052: hc = HCU(w[i].p);
3053: if ( trace ) {
3054: if ( mod == -2 ) {
3055: /* over a large finite field */
3056: /* trace = small modulus */
3057: a = nd_ps_trace[i] = ndv_dup(-2,w[i].p);
3058: ndv_mod(-2,a);
3059: if ( !dont_removecont) ndv_removecont(-2,a);
3060: am = nd_ps[i] = ndv_dup(trace,w[i].p);
3061: ndv_mod(trace,am);
3062: if ( DL_COMPARE(HDL(am),HDL(a)) )
3063: return 0;
3064: ndv_removecont(trace,am);
3065: } else {
3066: a = nd_ps_trace[i] = ndv_dup(0,w[i].p);
3067: if ( !dont_removecont) ndv_removecont(0,a);
3068: register_hcf(a);
3069: am = nd_ps[i] = ndv_dup(mod,a);
3070: ndv_mod(mod,am);
3071: if ( DL_COMPARE(HDL(am),HDL(a)) )
3072: return 0;
3073: ndv_removecont(mod,am);
3074: }
3075: } else {
3076: a = nd_ps[i] = ndv_dup(mod,w[i].p);
3077: if ( mod || !dont_removecont ) ndv_removecont(mod,a);
3078: if ( !mod ) register_hcf(a);
1.1 noro 3079: }
1.6 noro 3080: if ( nd_gentrace ) {
3081: STOZ(i,iq); STOZ(w[i].i,jq); node = mknode(3,iq,jq,ONE);
3082: /* exact division */
1.1 noro 3083: if ( !dont_removecont )
1.6 noro 3084: ARG2(node) = (pointer)ndc_div(trace?0:mod,hc,HCU(a));
3085: MKLIST(l,node); NEXTNODE(nd_tracelist,tn); BDY(tn) = l;
3086: }
3087: NEWRHist(r); SG(r) = HTD(a); ndl_copy(HDL(a),DL(r));
3088: nd_bound[i] = ndv_compute_bound(a);
3089: nd_psh[i] = r;
3090: if ( nd_demand ) {
3091: if ( trace ) {
3092: ndv_save(nd_ps_trace[i],i);
3093: nd_ps_sym[i] = ndv_symbolic(mod,nd_ps_trace[i]);
3094: nd_ps_trace_sym[i] = ndv_symbolic(mod,nd_ps_trace[i]);
3095: nd_ps_trace[i] = 0;
3096: } else {
3097: ndv_save(nd_ps[i],i);
3098: nd_ps_sym[i] = ndv_symbolic(mod,nd_ps[i]);
3099: nd_ps[i] = 0;
3100: }
1.1 noro 3101: }
1.6 noro 3102: }
3103: if ( nd_gentrace && nd_tracelist ) NEXT(tn) = 0;
3104: return 1;
1.1 noro 3105: }
3106:
3107: struct order_spec *append_block(struct order_spec *spec,
3108: int nv,int nalg,int ord);
3109:
3110: extern VECT current_dl_weight_vector_obj;
3111: static VECT prev_weight_vector_obj;
3112:
3113: void preprocess_algcoef(VL vv,VL av,struct order_spec *ord,LIST f,
3114: struct order_spec **ord1p,LIST *f1p,NODE *alistp)
3115: {
3116: NODE alist,t,s,r0,r,arg;
3117: VL tv;
3118: P poly;
3119: DP d;
3120: Alg alpha,dp;
3121: DAlg inv,da,hc;
3122: MP m;
3123: int i,nvar,nalg,n;
3124: NumberField nf;
3125: LIST f1,f2;
3126: struct order_spec *current_spec;
3127: VECT obj,obj0;
3128: VECT tmp;
3129:
3130: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++);
3131: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++);
3132:
3133: for ( alist = 0, tv = av; tv; tv = NEXT(tv) ) {
3134: NEXTNODE(alist,t); MKV(tv->v,poly);
3135: MKAlg(poly,alpha); BDY(t) = (pointer)alpha;
3136: tv->v = tv->v->priv;
3137: }
3138: NEXT(t) = 0;
3139:
3140: /* simplification, making polynomials monic */
3141: setfield_dalg(alist);
3142: obj_algtodalg((Obj)f,(Obj *)&f1);
3143: for ( t = BDY(f); t; t = NEXT(t) ) {
3144: initd(ord); ptod(vv,vv,(P)BDY(t),&d);
3145: hc = (DAlg)BDY(d)->c;
3146: if ( NID(hc) == N_DA ) {
3147: invdalg(hc,&inv);
3148: for ( m = BDY(d); m; m = NEXT(m) ) {
3149: muldalg(inv,(DAlg)m->c,&da); m->c = (Obj)da;
3150: }
3151: }
3152: initd(ord); dtop(vv,vv,d,(Obj *)&poly); BDY(f) = (pointer)poly;
3153: }
3154: obj_dalgtoalg((Obj)f1,(Obj *)&f);
3155:
3156: /* append alg vars to the var list */
3157: for ( tv = vv; NEXT(tv); tv = NEXT(tv) );
3158: NEXT(tv) = av;
3159:
3160: /* append a block to ord */
3161: *ord1p = append_block(ord,nvar,nalg,2);
3162:
3163: /* create generator list */
3164: nf = get_numberfield();
3165: for ( i = nalg-1, t = BDY(f); i >= 0; i-- ) {
3166: MKAlg(nf->defpoly[i],dp);
3167: MKNODE(s,dp,t); t = s;
3168: }
3169: MKLIST(f1,t);
3170: *alistp = alist;
3171: algobjtorat((Obj)f1,(Obj *)f1p);
3172:
3173: /* creating a new weight vector */
3174: prev_weight_vector_obj = obj0 = current_dl_weight_vector_obj;
3175: n = nvar+nalg+1;
3176: MKVECT(obj,n);
3177: if ( obj0 && obj0->len == nvar )
3178: for ( i = 0; i < nvar; i++ ) BDY(obj)[i] = BDY(obj0)[i];
3179: else
3180: for ( i = 0; i < nvar; i++ ) BDY(obj)[i] = (pointer)ONE;
3181: for ( i = 0; i < nalg; i++ ) BDY(obj)[i+nvar] = 0;
3182: BDY(obj)[n-1] = (pointer)ONE;
3183: arg = mknode(1,obj);
3184: Pdp_set_weight(arg,&tmp);
3185: }
3186:
3187: NODE postprocess_algcoef(VL av,NODE alist,NODE r)
3188: {
3189: NODE s,t,u0,u;
3190: P p;
3191: VL tv;
3192: Obj obj;
3193: VECT tmp;
3194: NODE arg;
3195:
3196: u0 = 0;
3197: for ( t = r; t; t = NEXT(t) ) {
3198: p = (P)BDY(t);
3199: for ( tv = av, s = alist; tv; tv = NEXT(tv), s = NEXT(s) ) {
3200: substr(CO,0,(Obj)p,tv->v,(Obj)BDY(s),&obj); p = (P)obj;
3201: }
3202: if ( OID(p) == O_P || (OID(p) == O_N && NID((Num)p) != N_A) ) {
3203: NEXTNODE(u0,u);
3204: BDY(u) = (pointer)p;
3205: }
3206: }
3207: arg = mknode(1,prev_weight_vector_obj);
3208: Pdp_set_weight(arg,&tmp);
3209:
3210: return u0;
3211: }
3212:
3213: void nd_gr(LIST f,LIST v,int m,int homo,int retdp,int f4,struct order_spec *ord,LIST *rp)
3214: {
3215: VL tv,fv,vv,vc,av;
3216: NODE fd,fd0,r,r0,t,x,s,xx,alist;
3217: int e,max,nvar,i;
3218: NDV b;
3219: int ishomo,nalg,mrank,trank,wmax,len;
3220: NMV a;
3221: Alg alpha,dp;
3222: P p,zp;
3223: Q dmy;
3224: LIST f1,f2,zpl;
3225: Obj obj;
3226: NumberField nf;
3227: struct order_spec *ord1;
3228: NODE tr,tl1,tl2,tl3,tl4,nzlist;
3229: LIST l1,l2,l3,l4,l5;
3230: int j;
3231: Z jq,bpe,last_nonzero;
3232: int *perm;
3233: EPOS oepos;
3234: int obpe,oadv,ompos,cbpe;
1.15 noro 3235: VECT hvect;
1.1 noro 3236:
3237: nd_module = 0;
3238: if ( !m && Demand ) nd_demand = 1;
3239: else nd_demand = 0;
3240: parse_nd_option(current_option);
3241:
3242: if ( DP_Multiple )
3243: nd_scale = ((double)DP_Multiple)/(double)(Denominator?Denominator:1);
3244: #if 0
3245: ndv_alloc = 0;
3246: #endif
3247: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
3248: if ( m && nd_vc )
3249: error("nd_{gr,f4} : computation over Fp(X) is unsupported. Use dp_gr_mod_main().");
3250: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
3251: switch ( ord->id ) {
3252: case 1:
3253: if ( ord->nv != nvar )
3254: error("nd_{gr,f4} : invalid order specification");
3255: break;
3256: default:
3257: break;
3258: }
3259: nd_nalg = 0;
3260: av = 0;
3261: if ( !m ) {
3262: get_algtree((Obj)f,&av);
3263: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++ );
3264: nd_ntrans = nvar;
3265: nd_nalg = nalg;
3266: /* #i -> t#i */
3267: if ( nalg ) {
3268: preprocess_algcoef(vv,av,ord,f,&ord1,&f1,&alist);
3269: ord = ord1;
3270: f = f1;
3271: }
3272: nvar += nalg;
3273: }
3274: nd_init_ord(ord);
3275: mrank = 0;
3276: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
3277: for ( tv = vv; tv; tv = NEXT(tv) ) {
3278: if ( nd_module ) {
1.16 noro 3279: if ( OID(BDY(t)) == O_DPM ) {
3280: e = dpm_getdeg((DPM)BDY(t),&trank);
3281: max = MAX(e,max);
3282: mrank = MAX(mrank,trank);
3283: } else {
3284: s = BDY((LIST)BDY(t));
3285: trank = length(s);
3286: mrank = MAX(mrank,trank);
3287: for ( ; s; s = NEXT(s) ) {
3288: e = getdeg(tv->v,(P)BDY(s));
3289: max = MAX(e,max);
3290: }
1.1 noro 3291: }
3292: } else {
3293: e = getdeg(tv->v,(P)BDY(t));
3294: max = MAX(e,max);
3295: }
3296: }
3297: nd_setup_parameters(nvar,nd_nzlist?0:max);
3298: obpe = nd_bpe; oadv = nmv_adv; oepos = nd_epos; ompos = nd_mpos;
3299: ishomo = 1;
3300: for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
3301: if ( nd_module ) {
1.16 noro 3302: if ( OID(BDY(t)) == O_DPM ) {
3303: Z cont;
3304: DPM zdpm;
3305:
3306: if ( !m && !nd_gentrace ) dpm_ptozp((DPM)BDY(t),&cont,&zdpm);
3307: else zdpm = (DPM)BDY(t);
3308: b = (pointer)dpmtondv(m,zdpm);
3309: } else {
3310: if ( !m && !nd_gentrace ) pltozpl((LIST)BDY(t),&dmy,&zpl);
3311: else zpl = (LIST)BDY(t);
1.1 noro 3312: b = (pointer)pltondv(CO,vv,zpl);
1.16 noro 3313: }
1.1 noro 3314: } else {
3315: if ( !m && !nd_gentrace ) ptozp((P)BDY(t),1,&dmy,&zp);
3316: else zp = (P)BDY(t);
3317: b = (pointer)ptondv(CO,vv,zp);
3318: }
3319: if ( ishomo )
3320: ishomo = ishomo && ndv_ishomo(b);
3321: if ( m ) ndv_mod(m,b);
3322: if ( b ) { NEXTNODE(fd0,fd); BDY(fd) = (pointer)b; }
3323: }
3324: if ( fd0 ) NEXT(fd) = 0;
3325:
3326: if ( !ishomo && homo ) {
3327: for ( t = fd0, wmax = max; t; t = NEXT(t) ) {
3328: b = (NDV)BDY(t); len = LEN(b);
3329: for ( a = BDY(b), i = 0; i < len; i++, NMV_ADV(a) )
3330: wmax = MAX(TD(DL(a)),wmax);
3331: }
3332: homogenize_order(ord,nvar,&ord1);
3333: nd_init_ord(ord1);
3334: nd_setup_parameters(nvar+1,nd_nzlist?0:wmax);
3335: for ( t = fd0; t; t = NEXT(t) )
3336: ndv_homogenize((NDV)BDY(t),obpe,oadv,oepos,ompos);
3337: }
3338:
3339: ndv_setup(m,0,fd0,(nd_gbblock||nd_splist||nd_check_splist)?1:0,0);
3340: if ( nd_gentrace ) {
3341: MKLIST(l1,nd_tracelist); MKNODE(nd_alltracelist,l1,0);
3342: }
3343: if ( nd_splist ) {
3344: *rp = compute_splist();
3345: return;
3346: }
3347: if ( nd_check_splist ) {
3348: if ( f4 ) {
3349: if ( check_splist_f4(m,nd_check_splist) ) *rp = (LIST)ONE;
3350: else *rp = 0;
3351: } else {
3352: if ( check_splist(m,nd_check_splist) ) *rp = (LIST)ONE;
3353: else *rp = 0;
3354: }
3355: return;
3356: }
3357: x = f4?nd_f4(m,0,&perm):nd_gb(m,ishomo || homo,0,0,&perm);
3358: if ( !x ) {
3359: *rp = 0; return;
3360: }
1.15 noro 3361: if ( nd_gentrace ) {
3362: MKVECT(hvect,nd_psn);
3363: for ( i = 0; i < nd_psn; i++ )
3364: ndltodp(nd_psh[i]->dl,(DP *)&BDY(hvect)[i]);
3365: }
1.1 noro 3366: if ( !ishomo && homo ) {
3367: /* dehomogenization */
3368: for ( t = x; t; t = NEXT(t) ) ndv_dehomogenize((NDV)BDY(t),ord);
3369: nd_init_ord(ord);
3370: nd_setup_parameters(nvar,0);
3371: }
3372: nd_demand = 0;
3373: if ( nd_module && nd_intersect ) {
3374: for ( j = nd_psn-1, x = 0; j >= 0; j-- )
1.17 noro 3375: if ( MPOS(DL(nd_psh[j])) > nd_intersect ) {
1.1 noro 3376: MKNODE(xx,(pointer)((unsigned long)j),x); x = xx;
3377: }
3378: conv_ilist(nd_demand,0,x,0);
3379: goto FINAL;
3380: }
3381: if ( nd_gentrace && f4 ) { nzlist = nd_alltracelist; }
3382: x = ndv_reducebase(x,perm);
3383: if ( nd_gentrace && !f4 ) { tl1 = nd_alltracelist; nd_alltracelist = 0; }
3384: x = ndv_reduceall(m,x);
3385: cbpe = nd_bpe;
3386: if ( nd_gentrace && !f4 ) {
3387: tl2 = nd_alltracelist; nd_alltracelist = 0;
3388: ndv_check_membership(m,fd0,obpe,oadv,oepos,x);
3389: tl3 = nd_alltracelist; nd_alltracelist = 0;
3390: if ( nd_gensyz ) {
3391: nd_gb(m,0,1,1,0);
3392: tl4 = nd_alltracelist; nd_alltracelist = 0;
3393: } else tl4 = 0;
3394: }
3395: nd_bpe = cbpe;
3396: nd_setup_parameters(nd_nvar,0);
3397: FINAL:
3398: for ( r0 = 0, t = x; t; t = NEXT(t) ) {
1.16 noro 3399: NEXTNODE(r0,r);
3400: if ( nd_module ) {
3401: if ( retdp ) BDY(r) = ndvtodpm(m,BDY(t));
3402: else BDY(r) = ndvtopl(m,CO,vv,BDY(t),mrank);
3403: } else if ( retdp ) BDY(r) = ndvtodp(m,BDY(t));
3404: else BDY(r) = ndvtop(m,CO,vv,BDY(t));
1.1 noro 3405: }
3406: if ( r0 ) NEXT(r) = 0;
3407: if ( !m && nd_nalg )
3408: r0 = postprocess_algcoef(av,alist,r0);
3409: MKLIST(*rp,r0);
3410: if ( nd_gentrace ) {
3411: if ( f4 ) {
1.6 noro 3412: STOZ(16,bpe);
3413: STOZ(nd_last_nonzero,last_nonzero);
1.15 noro 3414: tr = mknode(6,*rp,(!ishomo&&homo)?ONE:0,BDY(nzlist),bpe,last_nonzero,hvect); MKLIST(*rp,tr);
1.1 noro 3415: } else {
3416: tl1 = reverse_node(tl1); tl2 = reverse_node(tl2);
3417: tl3 = reverse_node(tl3);
3418: /* tl2 = [[i,[[*,j,*,*],...]],...] */
3419: for ( t = tl2; t; t = NEXT(t) ) {
3420: /* s = [i,[*,j,*,*],...] */
3421: s = BDY((LIST)BDY(t));
1.6 noro 3422: j = perm[ZTOS((Q)ARG0(s))]; STOZ(j,jq); ARG0(s) = (pointer)jq;
1.1 noro 3423: for ( s = BDY((LIST)ARG1(s)); s; s = NEXT(s) ) {
1.6 noro 3424: j = perm[ZTOS((Q)ARG1(BDY((LIST)BDY(s))))]; STOZ(j,jq);
1.1 noro 3425: ARG1(BDY((LIST)BDY(s))) = (pointer)jq;
3426: }
3427: }
3428: for ( j = length(x)-1, t = 0; j >= 0; j-- ) {
1.6 noro 3429: STOZ(perm[j],jq); MKNODE(s,jq,t); t = s;
1.1 noro 3430: }
3431: MKLIST(l1,tl1); MKLIST(l2,tl2); MKLIST(l3,t); MKLIST(l4,tl3);
3432: MKLIST(l5,tl4);
1.6 noro 3433: STOZ(nd_bpe,bpe);
1.15 noro 3434: tr = mknode(9,*rp,(!ishomo&&homo)?ONE:0,l1,l2,l3,l4,l5,bpe,hvect); MKLIST(*rp,tr);
1.1 noro 3435: }
3436: }
3437: #if 0
3438: fprintf(asir_out,"ndv_alloc=%d\n",ndv_alloc);
3439: #endif
3440: }
3441:
3442: void nd_gr_postproc(LIST f,LIST v,int m,struct order_spec *ord,int do_check,LIST *rp)
3443: {
3444: VL tv,fv,vv,vc,av;
3445: NODE fd,fd0,r,r0,t,x,s,xx,alist;
3446: int e,max,nvar,i;
3447: NDV b;
3448: int ishomo,nalg;
3449: Alg alpha,dp;
3450: P p,zp;
3451: Q dmy;
3452: LIST f1,f2;
3453: Obj obj;
3454: NumberField nf;
3455: struct order_spec *ord1;
3456: int *perm;
3457:
3458: parse_nd_option(current_option);
3459: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
3460: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
3461: switch ( ord->id ) {
3462: case 1:
3463: if ( ord->nv != nvar )
3464: error("nd_check : invalid order specification");
3465: break;
3466: default:
3467: break;
3468: }
3469: nd_nalg = 0;
3470: av = 0;
3471: if ( !m ) {
3472: get_algtree((Obj)f,&av);
3473: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++ );
3474: nd_ntrans = nvar;
3475: nd_nalg = nalg;
3476: /* #i -> t#i */
3477: if ( nalg ) {
3478: preprocess_algcoef(vv,av,ord,f,&ord1,&f1,&alist);
3479: ord = ord1;
3480: f = f1;
3481: }
3482: nvar += nalg;
3483: }
3484: nd_init_ord(ord);
3485: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
3486: for ( tv = vv; tv; tv = NEXT(tv) ) {
3487: e = getdeg(tv->v,(P)BDY(t));
3488: max = MAX(e,max);
3489: }
3490: nd_setup_parameters(nvar,max);
3491: ishomo = 1;
3492: for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
3493: ptozp((P)BDY(t),1,&dmy,&zp);
3494: b = (pointer)ptondv(CO,vv,zp);
3495: if ( ishomo )
3496: ishomo = ishomo && ndv_ishomo(b);
3497: if ( m ) ndv_mod(m,b);
3498: if ( b ) { NEXTNODE(fd0,fd); BDY(fd) = (pointer)b; }
3499: }
3500: if ( fd0 ) NEXT(fd) = 0;
3501: ndv_setup(m,0,fd0,0,1);
3502: for ( x = 0, i = 0; i < nd_psn; i++ )
3503: x = update_base(x,i);
3504: if ( do_check ) {
3505: x = nd_gb(m,ishomo,1,0,&perm);
3506: if ( !x ) {
3507: *rp = 0;
3508: return;
3509: }
3510: } else {
3511: #if 0
3512: /* bug ? */
3513: for ( t = x; t; t = NEXT(t) )
3514: BDY(t) = (pointer)nd_ps[(long)BDY(t)];
3515: #else
3516: conv_ilist(0,0,x,&perm);
3517: #endif
3518: }
3519: x = ndv_reducebase(x,perm);
3520: x = ndv_reduceall(m,x);
3521: for ( r0 = 0, t = x; t; t = NEXT(t) ) {
3522: NEXTNODE(r0,r);
3523: BDY(r) = ndvtop(m,CO,vv,BDY(t));
3524: }
3525: if ( r0 ) NEXT(r) = 0;
3526: if ( !m && nd_nalg )
3527: r0 = postprocess_algcoef(av,alist,r0);
3528: MKLIST(*rp,r0);
3529: }
3530:
3531: NDV recompute_trace(NODE trace,NDV *p,int m);
3532: void nd_gr_recompute_trace(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,LIST *rp);
3533:
3534: NDV recompute_trace(NODE ti,NDV *p,int mod)
3535: {
3536: int c,c1,c2,i;
3537: NM mul,m,tail;
3538: ND d,r,rm;
3539: NODE sj;
3540: NDV red;
3541: Obj mj;
3542:
3543: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
3544: CM(mul) = 1;
3545: tail = 0;
3546: for ( i = 0, d = r = 0; ti; ti = NEXT(ti), i++ ) {
3547: sj = BDY((LIST)BDY(ti));
3548: if ( ARG0(sj) ) {
1.6 noro 3549: red = p[ZTOS((Q)ARG1(sj))];
1.1 noro 3550: mj = (Obj)ARG2(sj);
3551: if ( OID(mj) != O_DP ) ndl_zero(DL(mul));
3552: else dltondl(nd_nvar,BDY((DP)mj)->dl,DL(mul));
3553: rm = ndv_mul_nm(mod,mul,red);
3554: if ( !r ) r = rm;
3555: else {
3556: for ( m = BDY(r); m && !ndl_equal(m->dl,BDY(rm)->dl); m = NEXT(m), LEN(r)-- ) {
3557: if ( d ) {
3558: NEXT(tail) = m; tail = m; LEN(d)++;
3559: } else {
3560: MKND(nd_nvar,m,1,d); tail = BDY(d);
3561: }
3562: }
3563: if ( !m ) return 0; /* failure */
3564: else {
3565: BDY(r) = m;
3566: if ( mod > 0 || mod == -1 ) {
3567: c1 = invm(HCM(rm),mod); c2 = mod-HCM(r);
3568: DMAR(c1,c2,0,mod,c);
3569: nd_mul_c(mod,rm,c);
3570: } else {
3571: Z t,u;
3572:
3573: chsgnlf(HCZ(r),&t);
3574: divlf(t,HCZ(rm),&u);
3575: nd_mul_c_lf(rm,u);
3576: }
3577: r = nd_add(mod,r,rm);
3578: }
3579: }
3580: }
3581: }
3582: if ( tail ) NEXT(tail) = 0;
3583: d = nd_add(mod,d,r);
3584: nd_mul_c(mod,d,invm(HCM(d),mod));
3585: return ndtondv(mod,d);
3586: }
3587:
3588: void nd_gr_recompute_trace(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,LIST *rp)
3589: {
3590: VL tv,fv,vv,vc,av;
3591: NODE fd,fd0,r,r0,t,x,s,xx,alist;
3592: int e,max,nvar,i;
3593: NDV b;
3594: int ishomo,nalg;
3595: Alg alpha,dp;
3596: P p,zp;
3597: Q dmy;
3598: LIST f1,f2;
3599: Obj obj;
3600: NumberField nf;
3601: struct order_spec *ord1;
3602: NODE permtrace,intred,ind,perm,trace,ti;
3603: int len,n,j;
3604: NDV *db,*pb;
3605:
3606: parse_nd_option(current_option);
3607: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
3608: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
3609: switch ( ord->id ) {
3610: case 1:
3611: if ( ord->nv != nvar )
3612: error("nd_check : invalid order specification");
3613: break;
3614: default:
3615: break;
3616: }
3617: nd_init_ord(ord);
1.6 noro 3618: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 3619: nd_setup_parameters(nvar,0);
3620:
3621: len = length(BDY(f));
3622: db = (NDV *)MALLOC(len*sizeof(NDV *));
3623: for ( i = 0, t = BDY(f); t; i++, t = NEXT(t) ) {
3624: ptozp((P)BDY(t),1,&dmy,&zp);
3625: b = ptondv(CO,vv,zp);
3626: ndv_mod(m,b);
3627: ndv_mul_c(m,b,invm(HCM(b),m));
3628: db[i] = b;
3629: }
3630:
3631: permtrace = BDY((LIST)ARG2(BDY(tlist)));
3632: intred = BDY((LIST)ARG3(BDY(tlist)));
3633: ind = BDY((LIST)ARG4(BDY(tlist)));
3634: perm = BDY((LIST)ARG0(permtrace));
3635: trace = NEXT(permtrace);
3636:
3637: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 3638: j = ZTOS((Q)ARG0(BDY((LIST)BDY(t))));
1.1 noro 3639: if ( j > i ) i = j;
3640: }
3641: n = i+1;
3642: pb = (NDV *)MALLOC(n*sizeof(NDV *));
3643: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
3644: ti = BDY((LIST)BDY(t));
1.6 noro 3645: pb[ZTOS((Q)ARG0(ti))] = db[ZTOS((Q)ARG1(ti))];
1.1 noro 3646: }
3647: for ( t = trace; t; t = NEXT(t) ) {
3648: ti = BDY((LIST)BDY(t));
1.6 noro 3649: pb[ZTOS((Q)ARG0(ti))] = recompute_trace(BDY((LIST)ARG1(ti)),pb,m);
3650: if ( !pb[ZTOS((Q)ARG0(ti))] ) { *rp = 0; return; }
1.1 noro 3651: if ( DP_Print ) {
3652: fprintf(asir_out,"."); fflush(asir_out);
3653: }
3654: }
3655: for ( t = intred; t; t = NEXT(t) ) {
3656: ti = BDY((LIST)BDY(t));
1.6 noro 3657: pb[ZTOS((Q)ARG0(ti))] = recompute_trace(BDY((LIST)ARG1(ti)),pb,m);
3658: if ( !pb[ZTOS((Q)ARG0(ti))] ) { *rp = 0; return; }
1.1 noro 3659: if ( DP_Print ) {
3660: fprintf(asir_out,"*"); fflush(asir_out);
3661: }
3662: }
3663: for ( r0 = 0, t = ind; t; t = NEXT(t) ) {
3664: NEXTNODE(r0,r);
1.6 noro 3665: b = pb[ZTOS((Q)BDY(t))];
1.1 noro 3666: ndv_mul_c(m,b,invm(HCM(b),m));
3667: #if 0
1.6 noro 3668: BDY(r) = ndvtop(m,CO,vv,pb[ZTOS((Q)BDY(t))]);
1.1 noro 3669: #else
1.6 noro 3670: BDY(r) = ndvtodp(m,pb[ZTOS((Q)BDY(t))]);
1.1 noro 3671: #endif
3672: }
3673: if ( r0 ) NEXT(r) = 0;
3674: MKLIST(*rp,r0);
3675: if ( DP_Print ) fprintf(asir_out,"\n");
3676: }
3677:
1.16 noro 3678: 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 3679: {
3680: VL tv,fv,vv,vc,av;
3681: NODE fd,fd0,in0,in,r,r0,t,s,cand,alist;
3682: int m,nocheck,nvar,mindex,e,max;
3683: NDV c;
3684: NMV a;
3685: P p,zp;
3686: Q dmy;
3687: EPOS oepos;
3688: int obpe,oadv,wmax,i,len,cbpe,ishomo,nalg,mrank,trank,ompos;
3689: Alg alpha,dp;
3690: P poly;
3691: LIST f1,f2,zpl;
3692: Obj obj;
3693: NumberField nf;
3694: struct order_spec *ord1;
3695: struct oEGT eg_check,eg0,eg1;
3696: NODE tr,tl1,tl2,tl3,tl4;
3697: LIST l1,l2,l3,l4,l5;
3698: int *perm;
3699: int j,ret;
3700: Z jq,bpe;
1.15 noro 3701: VECT hvect;
1.1 noro 3702:
3703: nd_module = 0;
3704: nd_lf = 0;
3705: parse_nd_option(current_option);
3706: if ( nd_lf ) {
3707: if ( f4 )
3708: nd_f4_lf_trace(f,v,trace,homo,ord,rp);
3709: else
3710: error("nd_gr_trace is not implemented yet over a large finite field");
3711: return;
3712: }
3713: if ( DP_Multiple )
3714: nd_scale = ((double)DP_Multiple)/(double)(Denominator?Denominator:1);
3715:
3716: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
3717: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
3718: switch ( ord->id ) {
3719: case 1:
3720: if ( ord->nv != nvar )
3721: error("nd_gr_trace : invalid order specification");
3722: break;
3723: default:
3724: break;
3725: }
3726:
3727: get_algtree((Obj)f,&av);
3728: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++ );
3729: nd_ntrans = nvar;
3730: nd_nalg = nalg;
3731: /* #i -> t#i */
3732: if ( nalg ) {
3733: preprocess_algcoef(vv,av,ord,f,&ord1,&f1,&alist);
3734: ord = ord1;
3735: f = f1;
3736: }
3737: nvar += nalg;
3738:
3739: nocheck = 0;
3740: mindex = 0;
3741:
3742: if ( Demand ) nd_demand = 1;
3743: else nd_demand = 0;
3744:
3745: /* setup modulus */
3746: if ( trace < 0 ) {
3747: trace = -trace;
3748: nocheck = 1;
3749: }
3750: m = trace > 1 ? trace : get_lprime(mindex);
3751: nd_init_ord(ord);
3752: mrank = 0;
3753: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
3754: for ( tv = vv; tv; tv = NEXT(tv) ) {
3755: if ( nd_module ) {
1.16 noro 3756: if ( OID(BDY(t)) == O_DPM ) {
3757: e = dpm_getdeg((DPM)BDY(t),&trank);
3758: max = MAX(e,max);
3759: mrank = MAX(mrank,trank);
3760: } else {
1.1 noro 3761: s = BDY((LIST)BDY(t));
3762: trank = length(s);
3763: mrank = MAX(mrank,trank);
3764: for ( ; s; s = NEXT(s) ) {
3765: e = getdeg(tv->v,(P)BDY(s));
3766: max = MAX(e,max);
3767: }
1.16 noro 3768: }
1.1 noro 3769: } else {
3770: e = getdeg(tv->v,(P)BDY(t));
3771: max = MAX(e,max);
3772: }
3773: }
3774: nd_setup_parameters(nvar,max);
3775: obpe = nd_bpe; oadv = nmv_adv; oepos = nd_epos; ompos = nd_mpos;
3776: ishomo = 1;
3777: for ( in0 = 0, fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
3778: if ( nd_module ) {
1.16 noro 3779: if ( OID(BDY(t)) == O_DPM ) {
3780: Z cont;
3781: DPM zdpm;
3782:
1.17 noro 3783: if ( !nd_gentrace ) dpm_ptozp((DPM)BDY(t),&cont,&zdpm);
1.16 noro 3784: else zdpm = (DPM)BDY(t);
3785: c = (pointer)dpmtondv(m,zdpm);
3786: } else {
3787: if ( !nd_gentrace ) pltozpl((LIST)BDY(t),&dmy,&zpl);
3788: else zpl = (LIST)BDY(t);
1.1 noro 3789: c = (pointer)pltondv(CO,vv,zpl);
1.16 noro 3790: }
1.1 noro 3791: } else {
1.16 noro 3792: if ( !nd_gentrace ) ptozp((P)BDY(t),1,&dmy,&zp);
3793: else zp = (P)BDY(t);
3794: c = (pointer)ptondv(CO,vv,zp);
1.1 noro 3795: }
3796: if ( ishomo )
3797: ishomo = ishomo && ndv_ishomo(c);
3798: if ( c ) {
3799: NEXTNODE(in0,in); BDY(in) = (pointer)c;
3800: NEXTNODE(fd0,fd); BDY(fd) = (pointer)ndv_dup(0,c);
3801: }
3802: }
3803: if ( in0 ) NEXT(in) = 0;
3804: if ( fd0 ) NEXT(fd) = 0;
3805: if ( !ishomo && homo ) {
3806: for ( t = in0, wmax = max; t; t = NEXT(t) ) {
3807: c = (NDV)BDY(t); len = LEN(c);
3808: for ( a = BDY(c), i = 0; i < len; i++, NMV_ADV(a) )
3809: wmax = MAX(TD(DL(a)),wmax);
3810: }
3811: homogenize_order(ord,nvar,&ord1);
3812: nd_init_ord(ord1);
3813: nd_setup_parameters(nvar+1,wmax);
3814: for ( t = fd0; t; t = NEXT(t) )
3815: ndv_homogenize((NDV)BDY(t),obpe,oadv,oepos,ompos);
3816: }
3817: if ( MaxDeg > 0 ) nocheck = 1;
3818: while ( 1 ) {
3819: tl1 = tl2 = tl3 = tl4 = 0;
3820: if ( Demand )
3821: nd_demand = 1;
3822: ret = ndv_setup(m,1,fd0,nd_gbblock?1:0,0);
3823: if ( nd_gentrace ) {
3824: MKLIST(l1,nd_tracelist); MKNODE(nd_alltracelist,l1,0);
3825: }
3826: if ( ret )
3827: cand = f4?nd_f4_trace(m,&perm):nd_gb_trace(m,ishomo || homo,&perm);
3828: if ( !ret || !cand ) {
3829: /* failure */
3830: if ( trace > 1 ) { *rp = 0; return; }
3831: else m = get_lprime(++mindex);
3832: continue;
3833: }
1.15 noro 3834: if ( nd_gentrace ) {
3835: MKVECT(hvect,nd_psn);
3836: for ( i = 0; i < nd_psn; i++ )
3837: ndltodp(nd_psh[i]->dl,(DP *)&BDY(hvect)[i]);
3838: }
1.1 noro 3839: if ( !ishomo && homo ) {
3840: /* dehomogenization */
3841: for ( t = cand; t; t = NEXT(t) ) ndv_dehomogenize((NDV)BDY(t),ord);
3842: nd_init_ord(ord);
3843: nd_setup_parameters(nvar,0);
3844: }
3845: nd_demand = 0;
3846: cand = ndv_reducebase(cand,perm);
3847: if ( nd_gentrace ) { tl1 = nd_alltracelist; nd_alltracelist = 0; }
3848: cand = ndv_reduceall(0,cand);
3849: cbpe = nd_bpe;
3850: if ( nd_gentrace ) { tl2 = nd_alltracelist; nd_alltracelist = 0; }
3851: get_eg(&eg0);
3852: if ( nocheck )
3853: break;
3854: if ( (ret = ndv_check_membership(0,in0,obpe,oadv,oepos,cand)) != 0 ) {
3855: if ( nd_gentrace ) {
3856: tl3 = nd_alltracelist; nd_alltracelist = 0;
3857: } else tl3 = 0;
3858: /* gbcheck : cand is a GB of Id(cand) ? */
3859: if ( nd_vc || nd_gentrace || nd_gensyz )
3860: ret = nd_gb(0,0,1,nd_gensyz?1:0,0)!=0;
3861: else
3862: ret = nd_f4(0,1,0)!=0;
3863: if ( nd_gentrace && nd_gensyz ) {
3864: tl4 = nd_alltracelist; nd_alltracelist = 0;
3865: } else tl4 = 0;
3866: }
3867: if ( ret ) break;
3868: else if ( trace > 1 ) {
3869: /* failure */
3870: *rp = 0; return;
3871: } else {
3872: /* try the next modulus */
3873: m = get_lprime(++mindex);
3874: /* reset the parameters */
3875: if ( !ishomo && homo ) {
3876: nd_init_ord(ord1);
3877: nd_setup_parameters(nvar+1,wmax);
3878: } else {
3879: nd_init_ord(ord);
3880: nd_setup_parameters(nvar,max);
3881: }
3882: }
3883: }
3884: get_eg(&eg1); init_eg(&eg_check); add_eg(&eg_check,&eg0,&eg1);
3885: if ( DP_Print )
1.6 noro 3886: fprintf(asir_out,"check=%.3fsec\n",eg_check.exectime);
1.1 noro 3887: /* dp->p */
3888: nd_bpe = cbpe;
3889: nd_setup_parameters(nd_nvar,0);
3890: for ( r = cand; r; r = NEXT(r) ) {
1.16 noro 3891: if ( nd_module ) {
1.17 noro 3892: if ( retdp ) BDY(r) = ndvtodpm(0,BDY(r));
1.16 noro 3893: else BDY(r) = ndvtopl(0,CO,vv,BDY(r),mrank);
1.17 noro 3894: } else if ( retdp ) BDY(r) = ndvtodp(0,BDY(r));
3895: else BDY(r) = (pointer)ndvtop(0,CO,vv,BDY(r));
1.1 noro 3896: }
3897: if ( nd_nalg )
3898: cand = postprocess_algcoef(av,alist,cand);
3899: MKLIST(*rp,cand);
3900: if ( nd_gentrace ) {
3901: tl1 = reverse_node(tl1); tl2 = reverse_node(tl2);
3902: tl3 = reverse_node(tl3);
3903: /* tl2 = [[i,[[*,j,*,*],...]],...] */
3904: for ( t = tl2; t; t = NEXT(t) ) {
3905: /* s = [i,[*,j,*,*],...] */
3906: s = BDY((LIST)BDY(t));
1.6 noro 3907: j = perm[ZTOS((Q)ARG0(s))]; STOZ(j,jq); ARG0(s) = (pointer)jq;
1.1 noro 3908: for ( s = BDY((LIST)ARG1(s)); s; s = NEXT(s) ) {
1.6 noro 3909: j = perm[ZTOS((Q)ARG1(BDY((LIST)BDY(s))))]; STOZ(j,jq);
1.1 noro 3910: ARG1(BDY((LIST)BDY(s))) = (pointer)jq;
3911: }
3912: }
3913: for ( j = length(cand)-1, t = 0; j >= 0; j-- ) {
1.6 noro 3914: STOZ(perm[j],jq); MKNODE(s,jq,t); t = s;
1.1 noro 3915: }
3916: MKLIST(l1,tl1); MKLIST(l2,tl2); MKLIST(l3,t); MKLIST(l4,tl3);
3917: MKLIST(l5,tl4);
1.6 noro 3918: STOZ(nd_bpe,bpe);
1.15 noro 3919: tr = mknode(9,*rp,(!ishomo&&homo)?ONE:0,l1,l2,l3,l4,l5,bpe,hvect); MKLIST(*rp,tr);
1.1 noro 3920: }
3921: }
3922:
3923: /* XXX : module element is not considered */
3924:
3925: void dltondl(int n,DL dl,UINT *r)
3926: {
3927: UINT *d;
3928: int i,j,l,s,ord_l;
3929: struct order_pair *op;
3930:
3931: d = (unsigned int *)dl->d;
3932: for ( i = 0; i < nd_wpd; i++ ) r[i] = 0;
3933: if ( nd_blockmask ) {
3934: l = nd_blockmask->n;
3935: op = nd_blockmask->order_pair;
3936: for ( j = 0, s = 0; j < l; j++ ) {
3937: ord_l = op[j].length;
3938: for ( i = 0; i < ord_l; i++, s++ ) PUT_EXP(r,s,d[s]);
3939: }
3940: TD(r) = ndl_weight(r);
3941: ndl_weight_mask(r);
3942: } else {
3943: for ( i = 0; i < n; i++ ) PUT_EXP(r,i,d[i]);
3944: TD(r) = ndl_weight(r);
3945: }
3946: }
3947:
3948: DL ndltodl(int n,UINT *ndl)
3949: {
3950: DL dl;
3951: int *d;
3952: int i,j,l,s,ord_l;
3953: struct order_pair *op;
3954:
3955: NEWDL(dl,n);
3956: dl->td = TD(ndl);
3957: d = dl->d;
3958: if ( nd_blockmask ) {
3959: l = nd_blockmask->n;
3960: op = nd_blockmask->order_pair;
3961: for ( j = 0, s = 0; j < l; j++ ) {
3962: ord_l = op[j].length;
3963: for ( i = 0; i < ord_l; i++, s++ ) d[s] = GET_EXP(ndl,s);
3964: }
3965: } else {
3966: for ( i = 0; i < n; i++ ) d[i] = GET_EXP(ndl,i);
3967: }
3968: return dl;
3969: }
3970:
3971: void nmtodp(int mod,NM m,DP *r)
3972: {
3973: DP dp;
3974: MP mr;
3975:
3976: NEWMP(mr);
3977: mr->dl = ndltodl(nd_nvar,DL(m));
3978: mr->c = (Obj)ndctop(mod,m->c);
3979: NEXT(mr) = 0; MKDP(nd_nvar,mr,dp); dp->sugar = mr->dl->td;
3980: *r = dp;
3981: }
3982:
1.15 noro 3983: void ndltodp(UINT *d,DP *r)
3984: {
3985: DP dp;
3986: MP mr;
3987:
3988: NEWMP(mr);
3989: mr->dl = ndltodl(nd_nvar,d);
3990: mr->c = (Obj)ONE;
3991: NEXT(mr) = 0; MKDP(nd_nvar,mr,dp); dp->sugar = mr->dl->td;
3992: *r = dp;
3993: }
3994:
1.1 noro 3995: void ndl_print(UINT *dl)
3996: {
3997: int n;
3998: int i,j,l,ord_l,s,s0;
3999: struct order_pair *op;
4000:
4001: n = nd_nvar;
4002: printf("<<");
4003: if ( nd_blockmask ) {
4004: l = nd_blockmask->n;
4005: op = nd_blockmask->order_pair;
4006: for ( j = 0, s = s0 = 0; j < l; j++ ) {
4007: ord_l = op[j].length;
4008: for ( i = 0; i < ord_l; i++, s++ )
4009: printf(s==n-1?"%d":"%d,",GET_EXP(dl,s));
4010: }
4011: } else {
4012: for ( i = 0; i < n; i++ ) printf(i==n-1?"%d":"%d,",GET_EXP(dl,i));
4013: }
4014: printf(">>");
4015: if ( nd_module && MPOS(dl) )
4016: printf("*e%d",MPOS(dl));
4017: }
4018:
4019: void nd_print(ND p)
4020: {
4021: NM m;
4022:
4023: if ( !p )
4024: printf("0\n");
4025: else {
4026: for ( m = BDY(p); m; m = NEXT(m) ) {
4027: if ( CM(m) & 0x80000000 ) printf("+@_%d*",IFTOF(CM(m)));
4028: else printf("+%d*",CM(m));
4029: ndl_print(DL(m));
4030: }
4031: printf("\n");
4032: }
4033: }
4034:
4035: void nd_print_q(ND p)
4036: {
4037: NM m;
4038:
4039: if ( !p )
4040: printf("0\n");
4041: else {
4042: for ( m = BDY(p); m; m = NEXT(m) ) {
4043: printf("+");
1.6 noro 4044: printexpr(CO,(Obj)CZ(m));
1.1 noro 4045: printf("*");
4046: ndl_print(DL(m));
4047: }
4048: printf("\n");
4049: }
4050: }
4051:
4052: void ndp_print(ND_pairs d)
4053: {
4054: ND_pairs t;
4055:
4056: for ( t = d; t; t = NEXT(t) ) printf("%d,%d ",t->i1,t->i2);
4057: printf("\n");
4058: }
4059:
4060: void nd_removecont(int mod,ND p)
4061: {
4062: int i,n;
4063: Z *w;
4064: NM m;
4065: struct oVECT v;
4066:
4067: if ( mod == -1 ) nd_mul_c(mod,p,_invsf(HCM(p)));
4068: else if ( mod == -2 ) {
4069: Z inv;
4070: divlf(ONE,HCZ(p),&inv);
4071: nd_mul_c_lf(p,inv);
4072: } else if ( mod ) nd_mul_c(mod,p,invm(HCM(p),mod));
4073: else {
4074: for ( m = BDY(p), n = 0; m; m = NEXT(m), n++ );
4075: w = (Z *)MALLOC(n*sizeof(Q));
4076: v.len = n;
4077: v.body = (pointer *)w;
1.6 noro 4078: for ( m = BDY(p), i = 0; i < n; m = NEXT(m), i++ ) w[i] = CZ(m);
1.1 noro 4079: removecont_array((P *)w,n,1);
1.6 noro 4080: for ( m = BDY(p), i = 0; i < n; m = NEXT(m), i++ ) CZ(m) = w[i];
1.1 noro 4081: }
4082: }
4083:
4084: void nd_removecont2(ND p1,ND p2)
4085: {
4086: int i,n1,n2,n;
4087: Z *w;
4088: NM m;
4089: struct oVECT v;
4090:
4091: n1 = nd_length(p1);
4092: n2 = nd_length(p2);
4093: n = n1+n2;
4094: w = (Z *)MALLOC(n*sizeof(Q));
4095: v.len = n;
4096: v.body = (pointer *)w;
4097: i = 0;
4098: if ( p1 )
1.6 noro 4099: for ( m = BDY(p1); i < n1; m = NEXT(m), i++ ) w[i] = CZ(m);
1.1 noro 4100: if ( p2 )
1.6 noro 4101: for ( m = BDY(p2); i < n; m = NEXT(m), i++ ) w[i] = CZ(m);
1.1 noro 4102: removecont_array((P *)w,n,1);
4103: i = 0;
4104: if ( p1 )
1.6 noro 4105: for ( m = BDY(p1); i < n1; m = NEXT(m), i++ ) CZ(m) = w[i];
1.1 noro 4106: if ( p2 )
1.6 noro 4107: for ( m = BDY(p2); i < n; m = NEXT(m), i++ ) CZ(m) = w[i];
1.1 noro 4108: }
4109:
4110: void ndv_removecont(int mod,NDV p)
4111: {
4112: int i,len,all_p;
4113: Z *c;
4114: P *w;
4115: Z dvr,t;
4116: P g,cont,tp;
4117: NMV m;
4118:
4119: if ( mod == -1 )
4120: ndv_mul_c(mod,p,_invsf(HCM(p)));
4121: else if ( mod == -2 ) {
4122: Z inv;
4123: divlf(ONE,HCZ(p),&inv);
4124: ndv_mul_c_lf(p,inv);
4125: } else if ( mod )
4126: ndv_mul_c(mod,p,invm(HCM(p),mod));
4127: else {
4128: len = p->len;
4129: w = (P *)MALLOC(len*sizeof(P));
4130: c = (Z *)MALLOC(len*sizeof(Q));
4131: for ( m = BDY(p), all_p = 1, i = 0; i < len; NMV_ADV(m), i++ ) {
4132: ptozp(CP(m),1,(Q *)&c[i],&w[i]);
4133: all_p = all_p && !NUM(w[i]);
4134: }
4135: if ( all_p ) {
4136: qltozl((Q *)c,len,&dvr); nd_heu_nezgcdnpz(nd_vc,w,len,1,&g);
4137: mulp(nd_vc,(P)dvr,g,&cont);
4138: for ( m = BDY(p), i = 0; i < len; NMV_ADV(m), i++ ) {
4139: divsp(nd_vc,CP(m),cont,&tp); CP(m) = tp;
4140: }
4141: } else {
4142: sortbynm((Q *)c,len);
4143: qltozl((Q *)c,len,&dvr);
4144: for ( m = BDY(p), i = 0; i < len; NMV_ADV(m), i++ ) {
4145: divsp(nd_vc,CP(m),(P)dvr,&tp); CP(m) = tp;
4146: }
4147: }
4148: }
4149: }
4150:
4151: /* koko */
4152:
4153: void ndv_homogenize(NDV p,int obpe,int oadv,EPOS oepos,int ompos)
4154: {
4155: int len,i,max;
4156: NMV m,mr0,mr,t;
4157:
4158: len = p->len;
1.14 noro 4159: for ( m = BDY(p), i = 0, max = 0; i < len; NMV_OADV(m), i++ )
1.1 noro 4160: max = MAX(max,TD(DL(m)));
4161: mr0 = nmv_adv>oadv?(NMV)REALLOC(BDY(p),len*nmv_adv):BDY(p);
4162: m = (NMV)((char *)mr0+(len-1)*oadv);
4163: mr = (NMV)((char *)mr0+(len-1)*nmv_adv);
4164: t = (NMV)MALLOC(nmv_adv);
4165: for ( i = 0; i < len; i++, NMV_OPREV(m), NMV_PREV(mr) ) {
4166: ndl_homogenize(DL(m),DL(t),obpe,oepos,ompos,max);
1.6 noro 4167: CZ(mr) = CZ(m);
1.1 noro 4168: ndl_copy(DL(t),DL(mr));
4169: }
4170: NV(p)++;
4171: BDY(p) = mr0;
4172: }
4173:
4174: void ndv_dehomogenize(NDV p,struct order_spec *ord)
4175: {
4176: int i,j,adj,len,newnvar,newwpd,newadv,newexporigin,newmpos;
4177: int pos;
4178: Q *w;
4179: Q dvr,t;
4180: NMV m,r;
4181:
4182: len = p->len;
4183: newnvar = nd_nvar-1;
4184: newexporigin = nd_get_exporigin(ord);
4185: if ( nd_module ) newmpos = newexporigin-1;
4186: newwpd = newnvar/nd_epw+(newnvar%nd_epw?1:0)+newexporigin;
4187: for ( m = BDY(p), i = 0; i < len; NMV_ADV(m), i++ )
4188: ndl_dehomogenize(DL(m));
4189: if ( newwpd != nd_wpd ) {
4190: newadv = ROUND_FOR_ALIGN(sizeof(struct oNMV)+(newwpd-1)*sizeof(UINT));
4191: for ( m = r = BDY(p), i = 0; i < len; NMV_ADV(m), NDV_NADV(r), i++ ) {
1.6 noro 4192: CZ(r) = CZ(m);
1.1 noro 4193: if ( nd_module ) pos = MPOS(DL(m));
4194: for ( j = 0; j < newexporigin; j++ ) DL(r)[j] = DL(m)[j];
4195: adj = nd_exporigin-newexporigin;
4196: for ( ; j < newwpd; j++ ) DL(r)[j] = DL(m)[j+adj];
4197: if ( nd_module ) {
4198: DL(r)[newmpos] = pos;
4199: }
4200: }
4201: }
4202: NV(p)--;
4203: }
4204:
4205: void nd_heu_nezgcdnpz(VL vl,P *pl,int m,int full,P *pr)
4206: {
4207: int i;
4208: P *tpl,*tpl1;
4209: NODE l;
4210: P h,gcd,t;
4211:
4212: tpl = (P *)MALLOC(m*sizeof(P));
4213: tpl1 = (P *)MALLOC(m*sizeof(P));
4214: bcopy(pl,tpl,m*sizeof(P));
4215: gcd = (P)ONE;
4216: for ( l = nd_hcf; l; l = NEXT(l) ) {
4217: h = (P)BDY(l);
4218: while ( 1 ) {
4219: for ( i = 0; i < m; i++ )
4220: if ( !divtpz(vl,tpl[i],h,&tpl1[i]) )
4221: break;
4222: if ( i == m ) {
4223: bcopy(tpl1,tpl,m*sizeof(P));
4224: mulp(vl,gcd,h,&t); gcd = t;
4225: } else
4226: break;
4227: }
4228: }
4229: if ( DP_Print > 2 ){fprintf(asir_out,"[%d]",nmonop(gcd)); fflush(asir_out);}
4230: if ( full ) {
4231: heu_nezgcdnpz(vl,tpl,m,&t);
4232: mulp(vl,gcd,t,pr);
4233: } else
4234: *pr = gcd;
4235: }
4236:
4237: void removecont_array(P *p,int n,int full)
4238: {
4239: int all_p,all_q,i;
4240: Z *c;
4241: P *w;
4242: P t,s;
4243:
4244: for ( all_q = 1, i = 0; i < n; i++ )
4245: all_q = all_q && NUM(p[i]);
4246: if ( all_q ) {
4247: removecont_array_q((Z *)p,n);
4248: } else {
4249: c = (Z *)MALLOC(n*sizeof(Z));
4250: w = (P *)MALLOC(n*sizeof(P));
4251: for ( i = 0; i < n; i++ ) {
4252: ptozp(p[i],1,(Q *)&c[i],&w[i]);
4253: }
4254: removecont_array_q(c,n);
4255: nd_heu_nezgcdnpz(nd_vc,w,n,full,&t);
4256: for ( i = 0; i < n; i++ ) {
4257: divsp(nd_vc,w[i],t,&s); mulp(nd_vc,s,(P)c[i],&p[i]);
4258: }
4259: }
4260: }
4261:
4262: /* c is an int array */
4263:
4264: void removecont_array_q(Z *c,int n)
4265: {
4266: struct oVECT v;
4267: Z d0,d1,a,u,u1,gcd;
4268: int i,j;
4269: Z *q,*r;
4270:
4271: q = (Z *)MALLOC(n*sizeof(Z));
4272: r = (Z *)MALLOC(n*sizeof(Z));
4273: v.id = O_VECT; v.len = n; v.body = (pointer *)c;
4274: gcdvz_estimate(&v,&d0);
4275: for ( i = 0; i < n; i++ ) {
4276: divqrz(c[i],d0,&q[i],&r[i]);
4277: }
4278: for ( i = 0; i < n; i++ ) if ( r[i] ) break;
4279: if ( i < n ) {
4280: v.id = O_VECT; v.len = n; v.body = (pointer *)r;
4281: gcdvz(&v,&d1);
4282: gcdz(d0,d1,&gcd);
1.6 noro 4283: /* exact division */
4284: divsz(d0,gcd,&a);
1.1 noro 4285: for ( i = 0; i < n; i++ ) {
4286: mulz(a,q[i],&u);
4287: if ( r[i] ) {
1.6 noro 4288: /* exact division */
4289: divsz(r[i],gcd,&u1);
1.1 noro 4290: addz(u,u1,&q[i]);
4291: } else
4292: q[i] = u;
4293: }
4294: }
4295: for ( i = 0; i < n; i++ ) c[i] = q[i];
4296: }
4297:
1.4 noro 4298: void gcdv_mpz_estimate(mpz_t d0,mpz_t *c,int n);
4299:
4300: void mpz_removecont_array(mpz_t *c,int n)
4301: {
4302: mpz_t d0,a,u,u1,gcd;
4303: int i,j;
1.13 noro 4304: static mpz_t *q,*r;
4305: static int c_len = 0;
1.4 noro 4306:
4307: for ( i = 0; i < n; i++ )
4308: if ( mpz_sgn(c[i]) ) break;
4309: if ( i == n ) return;
4310: gcdv_mpz_estimate(d0,c,n);
1.13 noro 4311: if ( n > c_len ) {
4312: q = (mpz_t *)MALLOC(n*sizeof(mpz_t));
4313: r = (mpz_t *)MALLOC(n*sizeof(mpz_t));
4314: c_len = n;
4315: }
1.4 noro 4316: for ( i = 0; i < n; i++ ) {
4317: mpz_init(q[i]); mpz_init(r[i]);
4318: mpz_fdiv_qr(q[i],r[i],c[i],d0);
4319: }
4320: for ( i = 0; i < n; i++ )
4321: if ( mpz_sgn(r[i]) ) break;
4322: mpz_init(gcd); mpz_init(a); mpz_init(u); mpz_init(u1);
4323: if ( i < n ) {
4324: mpz_gcd(gcd,d0,r[i]);
4325: for ( j = i+1; j < n; j++ ) mpz_gcd(gcd,gcd,r[j]);
4326: mpz_div(a,d0,gcd);
4327: for ( i = 0; i < n; i++ ) {
4328: mpz_mul(u,a,q[i]);
4329: if ( mpz_sgn(r[i]) ) {
4330: mpz_div(u1,r[i],gcd);
4331: mpz_add(q[i],u,u1);
4332: } else
4333: mpz_set(q[i],u);
4334: }
4335: }
4336: for ( i = 0; i < n; i++ )
4337: mpz_set(c[i],q[i]);
4338: }
4339:
1.1 noro 4340: void nd_mul_c(int mod,ND p,int mul)
4341: {
4342: NM m;
4343: int c,c1;
4344:
4345: if ( !p ) return;
4346: if ( mul == 1 ) return;
4347: if ( mod == -1 )
4348: for ( m = BDY(p); m; m = NEXT(m) )
4349: CM(m) = _mulsf(CM(m),mul);
4350: else
4351: for ( m = BDY(p); m; m = NEXT(m) ) {
4352: c1 = CM(m); DMAR(c1,mul,0,mod,c); CM(m) = c;
4353: }
4354: }
4355:
4356: void nd_mul_c_lf(ND p,Z mul)
4357: {
4358: NM m;
4359: Z c;
4360:
4361: if ( !p ) return;
4362: if ( UNIZ(mul) ) return;
4363: for ( m = BDY(p); m; m = NEXT(m) ) {
4364: mullf(CZ(m),mul,&c); CZ(m) = c;
4365: }
4366: }
4367:
4368: void nd_mul_c_q(ND p,P mul)
4369: {
4370: NM m;
4371: P c;
4372:
4373: if ( !p ) return;
4374: if ( UNIQ(mul) ) return;
4375: for ( m = BDY(p); m; m = NEXT(m) ) {
4376: mulp(nd_vc,CP(m),mul,&c); CP(m) = c;
4377: }
4378: }
4379:
4380: void nd_mul_c_p(VL vl,ND p,P mul)
4381: {
4382: NM m;
4383: P c;
4384:
4385: if ( !p ) return;
4386: for ( m = BDY(p); m; m = NEXT(m) ) {
4387: mulp(vl,CP(m),mul,&c); CP(m) = c;
4388: }
4389: }
4390:
4391: void nd_free(ND p)
4392: {
4393: NM t,s;
4394:
4395: if ( !p ) return;
4396: t = BDY(p);
4397: while ( t ) {
4398: s = NEXT(t);
4399: FREENM(t);
4400: t = s;
4401: }
4402: FREEND(p);
4403: }
4404:
4405: void ndv_free(NDV p)
4406: {
4407: GCFREE(BDY(p));
4408: }
4409:
4410: void nd_append_red(UINT *d,int i)
4411: {
4412: RHist m,m0;
4413: int h;
4414:
4415: NEWRHist(m);
4416: h = ndl_hash_value(d);
4417: m->index = i;
4418: ndl_copy(d,DL(m));
4419: NEXT(m) = nd_red[h];
4420: nd_red[h] = m;
4421: }
4422:
4423: UINT *ndv_compute_bound(NDV p)
4424: {
4425: UINT *d1,*d2,*t;
4426: UINT u;
4427: int i,j,k,l,len,ind;
4428: NMV m;
4429:
4430: if ( !p )
4431: return 0;
4432: d1 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
4433: d2 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
4434: len = LEN(p);
4435: m = BDY(p); ndl_copy(DL(m),d1); NMV_ADV(m);
4436: for ( i = 1; i < len; i++, NMV_ADV(m) ) {
4437: ndl_max(DL(m),d1,d2);
4438: t = d1; d1 = d2; d2 = t;
4439: }
4440: l = nd_nvar+31;
4441: t = (UINT *)MALLOC_ATOMIC(l*sizeof(UINT));
4442: for ( i = nd_exporigin, ind = 0; i < nd_wpd; i++ ) {
4443: u = d1[i];
4444: k = (nd_epw-1)*nd_bpe;
4445: for ( j = 0; j < nd_epw; j++, k -= nd_bpe, ind++ )
4446: t[ind] = (u>>k)&nd_mask0;
4447: }
4448: for ( ; ind < l; ind++ ) t[ind] = 0;
4449: return t;
4450: }
4451:
4452: UINT *nd_compute_bound(ND p)
4453: {
4454: UINT *d1,*d2,*t;
4455: UINT u;
4456: int i,j,k,l,len,ind;
4457: NM m;
4458:
4459: if ( !p )
4460: return 0;
4461: d1 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
4462: d2 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
4463: len = LEN(p);
4464: m = BDY(p); ndl_copy(DL(m),d1); m = NEXT(m);
4465: for ( m = NEXT(m); m; m = NEXT(m) ) {
4466: ndl_lcm(DL(m),d1,d2);
4467: t = d1; d1 = d2; d2 = t;
4468: }
4469: l = nd_nvar+31;
4470: t = (UINT *)MALLOC_ATOMIC(l*sizeof(UINT));
4471: for ( i = nd_exporigin, ind = 0; i < nd_wpd; i++ ) {
4472: u = d1[i];
4473: k = (nd_epw-1)*nd_bpe;
4474: for ( j = 0; j < nd_epw; j++, k -= nd_bpe, ind++ )
4475: t[ind] = (u>>k)&nd_mask0;
4476: }
4477: for ( ; ind < l; ind++ ) t[ind] = 0;
4478: return t;
4479: }
4480:
4481: /* if nd_module == 1 then d[nd_exporigin-1] indicates the position */
4482: /* of a term. In this case we need additional 1 word. */
4483:
4484: int nd_get_exporigin(struct order_spec *ord)
4485: {
4486: switch ( ord->id ) {
4487: case 0: case 2: case 256: case 258:
4488: return 1+nd_module;
4489: case 1: case 257:
4490: /* block order */
4491: /* poly ring d[0]:weight d[1]:w0,...,d[nd_exporigin-1]:w(n-1) */
4492: /* module d[0]:weight d[1]:w0,...,d[nd_exporigin-2]:w(n-1) */
4493: return ord->ord.block.length+1+nd_module;
4494: case 3: case 259:
4495: #if 0
4496: error("nd_get_exporigin : composite order is not supported yet.");
4497: #else
4498: return 1+nd_module;
4499: #endif
4500: default:
4501: error("nd_get_exporigin : ivalid argument.");
4502: return 0;
4503: }
4504: }
4505:
4506: void nd_setup_parameters(int nvar,int max) {
4507: int i,j,n,elen,ord_o,ord_l,l,s,wpd;
4508: struct order_pair *op;
4509:
4510: nd_nvar = nvar;
4511: if ( max ) {
4512: /* XXX */
4513: if ( do_weyl ) nd_bpe = 32;
4514: else if ( max < 2 ) nd_bpe = 1;
4515: else if ( max < 4 ) nd_bpe = 2;
4516: else if ( max < 8 ) nd_bpe = 3;
4517: else if ( max < 16 ) nd_bpe = 4;
4518: else if ( max < 32 ) nd_bpe = 5;
4519: else if ( max < 64 ) nd_bpe = 6;
4520: else if ( max < 256 ) nd_bpe = 8;
4521: else if ( max < 1024 ) nd_bpe = 10;
4522: else if ( max < 65536 ) nd_bpe = 16;
4523: else nd_bpe = 32;
4524: }
4525: if ( !do_weyl && weight_check && (current_dl_weight_vector || nd_matrix) ) {
4526: UINT t;
4527: int st;
4528: int *v;
4529: /* t = max(weights) */
4530: t = 0;
4531: if ( current_dl_weight_vector )
4532: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
4533: if ( (st=current_dl_weight_vector[i]) < 0 ) st = -st;
4534: if ( t < st ) t = st;
4535: }
4536: if ( nd_matrix )
4537: for ( i = 0; i < nd_matrix_len; i++ )
4538: for ( j = 0, v = nd_matrix[i]; j < nd_nvar; j++ ) {
4539: if ( (st=v[j]) < 0 ) st = -st;
4540: if ( t < st ) t = st;
4541: }
4542: /* i = bitsize of t */
4543: for ( i = 0; t; t >>=1, i++ );
4544: /* i += bitsize of nd_nvar */
4545: for ( t = nd_nvar; t; t >>=1, i++);
4546: /* nd_bpe+i = bitsize of max(weights)*max(exp)*nd_nvar */
4547: if ( (nd_bpe+i) >= 31 )
4548: error("nd_setup_parameters : too large weight");
4549: }
4550: nd_epw = (sizeof(UINT)*8)/nd_bpe;
4551: elen = nd_nvar/nd_epw+(nd_nvar%nd_epw?1:0);
4552: nd_exporigin = nd_get_exporigin(nd_ord);
4553: wpd = nd_exporigin+elen;
4554: if ( nd_module )
4555: nd_mpos = nd_exporigin-1;
4556: else
4557: nd_mpos = -1;
4558: if ( wpd != nd_wpd ) {
4559: nd_free_private_storage();
4560: nd_wpd = wpd;
4561: }
4562: if ( nd_bpe < 32 ) {
4563: nd_mask0 = (1<<nd_bpe)-1;
4564: } else {
4565: nd_mask0 = 0xffffffff;
4566: }
4567: bzero(nd_mask,sizeof(nd_mask));
4568: nd_mask1 = 0;
4569: for ( i = 0; i < nd_epw; i++ ) {
4570: nd_mask[nd_epw-i-1] = (nd_mask0<<(i*nd_bpe));
4571: nd_mask1 |= (1<<(nd_bpe-1))<<(i*nd_bpe);
4572: }
4573: nmv_adv = ROUND_FOR_ALIGN(sizeof(struct oNMV)+(nd_wpd-1)*sizeof(UINT));
4574: nd_epos = nd_create_epos(nd_ord);
4575: nd_blockmask = nd_create_blockmask(nd_ord);
4576: nd_work_vector = (int *)REALLOC(nd_work_vector,nd_nvar*sizeof(int));
4577: }
4578:
4579: ND_pairs nd_reconstruct(int trace,ND_pairs d)
4580: {
4581: int i,obpe,oadv,h;
4582: static NM prev_nm_free_list;
4583: static ND_pairs prev_ndp_free_list;
4584: RHist mr0,mr;
4585: RHist r;
4586: RHist *old_red;
4587: ND_pairs s0,s,t;
4588: EPOS oepos;
4589:
4590: obpe = nd_bpe;
4591: oadv = nmv_adv;
4592: oepos = nd_epos;
4593: if ( obpe < 2 ) nd_bpe = 2;
4594: else if ( obpe < 3 ) nd_bpe = 3;
4595: else if ( obpe < 4 ) nd_bpe = 4;
4596: else if ( obpe < 5 ) nd_bpe = 5;
4597: else if ( obpe < 6 ) nd_bpe = 6;
4598: else if ( obpe < 8 ) nd_bpe = 8;
4599: else if ( obpe < 10 ) nd_bpe = 10;
4600: else if ( obpe < 16 ) nd_bpe = 16;
4601: else if ( obpe < 32 ) nd_bpe = 32;
4602: else error("nd_reconstruct : exponent too large");
4603:
4604: nd_setup_parameters(nd_nvar,0);
4605: prev_nm_free_list = _nm_free_list;
4606: prev_ndp_free_list = _ndp_free_list;
4607: _nm_free_list = 0;
4608: _ndp_free_list = 0;
4609: for ( i = nd_psn-1; i >= 0; i-- ) {
4610: ndv_realloc(nd_ps[i],obpe,oadv,oepos);
4611: ndv_realloc(nd_ps_sym[i],obpe,oadv,oepos);
4612: }
4613: if ( trace )
4614: for ( i = nd_psn-1; i >= 0; i-- ) {
4615: ndv_realloc(nd_ps_trace[i],obpe,oadv,oepos);
4616: ndv_realloc(nd_ps_trace_sym[i],obpe,oadv,oepos);
4617: }
4618: s0 = 0;
4619: for ( t = d; t; t = NEXT(t) ) {
4620: NEXTND_pairs(s0,s);
4621: s->i1 = t->i1;
4622: s->i2 = t->i2;
4623: SG(s) = SG(t);
4624: ndl_reconstruct(LCM(t),LCM(s),obpe,oepos);
4625: }
4626:
4627: old_red = (RHist *)MALLOC(REDTAB_LEN*sizeof(RHist));
4628: for ( i = 0; i < REDTAB_LEN; i++ ) {
4629: old_red[i] = nd_red[i];
4630: nd_red[i] = 0;
4631: }
4632: for ( i = 0; i < REDTAB_LEN; i++ )
4633: for ( r = old_red[i]; r; r = NEXT(r) ) {
4634: NEWRHist(mr);
4635: mr->index = r->index;
4636: SG(mr) = SG(r);
4637: ndl_reconstruct(DL(r),DL(mr),obpe,oepos);
4638: h = ndl_hash_value(DL(mr));
4639: NEXT(mr) = nd_red[h];
4640: nd_red[h] = mr;
4641: }
4642: for ( i = 0; i < REDTAB_LEN; i++ ) old_red[i] = 0;
4643: old_red = 0;
4644: for ( i = 0; i < nd_psn; i++ ) {
4645: NEWRHist(r); SG(r) = SG(nd_psh[i]);
4646: ndl_reconstruct(DL(nd_psh[i]),DL(r),obpe,oepos);
4647: nd_psh[i] = r;
4648: }
4649: if ( s0 ) NEXT(s) = 0;
4650: prev_nm_free_list = 0;
4651: prev_ndp_free_list = 0;
4652: #if 0
4653: GC_gcollect();
4654: #endif
4655: return s0;
4656: }
4657:
4658: void ndl_reconstruct(UINT *d,UINT *r,int obpe,EPOS oepos)
4659: {
4660: int n,i,ei,oepw,omask0,j,s,ord_l,l;
4661: struct order_pair *op;
4662:
4663: n = nd_nvar;
4664: oepw = (sizeof(UINT)*8)/obpe;
4665: omask0 = (1<<obpe)-1;
4666: TD(r) = TD(d);
4667: for ( i = nd_exporigin; i < nd_wpd; i++ ) r[i] = 0;
4668: if ( nd_blockmask ) {
4669: l = nd_blockmask->n;
4670: op = nd_blockmask->order_pair;
4671: for ( i = 1; i < nd_exporigin; i++ )
4672: r[i] = d[i];
4673: for ( j = 0, s = 0; j < l; j++ ) {
4674: ord_l = op[j].length;
4675: for ( i = 0; i < ord_l; i++, s++ ) {
4676: ei = GET_EXP_OLD(d,s);
4677: PUT_EXP(r,s,ei);
4678: }
4679: }
4680: } else {
4681: for ( i = 0; i < n; i++ ) {
4682: ei = GET_EXP_OLD(d,i);
4683: PUT_EXP(r,i,ei);
4684: }
4685: }
4686: if ( nd_module ) MPOS(r) = MPOS(d);
4687: }
4688:
4689: ND nd_copy(ND p)
4690: {
4691: NM m,mr,mr0;
4692: int c,n;
4693: ND r;
4694:
4695: if ( !p )
4696: return 0;
4697: else {
4698: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
4699: NEXTNM(mr0,mr);
4700: CM(mr) = CM(m);
4701: ndl_copy(DL(m),DL(mr));
4702: }
4703: NEXT(mr) = 0;
4704: MKND(NV(p),mr0,LEN(p),r);
4705: SG(r) = SG(p);
4706: return r;
4707: }
4708: }
4709:
4710: int nd_sp(int mod,int trace,ND_pairs p,ND *rp)
4711: {
4712: NM m1,m2;
4713: NDV p1,p2;
4714: ND t1,t2;
4715: UINT *lcm;
4716: P gp,tp;
4717: Z g,t;
4718: Z iq;
4719: int td;
4720: LIST hist;
4721: NODE node;
4722: DP d;
4723:
4724: if ( !mod && nd_demand ) {
4725: p1 = ndv_load(p->i1); p2 = ndv_load(p->i2);
4726: } else {
4727: if ( trace ) {
4728: p1 = nd_ps_trace[p->i1]; p2 = nd_ps_trace[p->i2];
4729: } else {
4730: p1 = nd_ps[p->i1]; p2 = nd_ps[p->i2];
4731: }
4732: }
4733: lcm = LCM(p);
4734: NEWNM(m1); ndl_sub(lcm,HDL(p1),DL(m1));
4735: if ( ndl_check_bound2(p->i1,DL(m1)) ) {
4736: FREENM(m1); return 0;
4737: }
4738: NEWNM(m2); ndl_sub(lcm,HDL(p2),DL(m2));
4739: if ( ndl_check_bound2(p->i2,DL(m2)) ) {
4740: FREENM(m1); FREENM(m2); return 0;
4741: }
4742:
4743: if ( mod == -1 ) {
4744: CM(m1) = HCM(p2); CM(m2) = _chsgnsf(HCM(p1));
4745: } else if ( mod > 0 ) {
4746: CM(m1) = HCM(p2); CM(m2) = mod-HCM(p1);
4747: } else if ( mod == -2 ) {
4748: CZ(m1) = HCZ(p2); chsgnlf(HCZ(p1),&CZ(m2));
4749: } else if ( nd_vc ) {
4750: ezgcdpz(nd_vc,HCP(p1),HCP(p2),&gp);
4751: divsp(nd_vc,HCP(p2),gp,&CP(m1));
4752: divsp(nd_vc,HCP(p1),gp,&tp); chsgnp(tp,&CP(m2));
4753: } else {
1.6 noro 4754: igcd_cofactor(HCZ(p1),HCZ(p2),&g,&t,&CZ(m1)); chsgnz(t,&CZ(m2));
1.1 noro 4755: }
4756: t1 = ndv_mul_nm(mod,m1,p1); t2 = ndv_mul_nm(mod,m2,p2);
4757: *rp = nd_add(mod,t1,t2);
4758: if ( nd_gentrace ) {
4759: /* nd_tracelist is initialized */
1.6 noro 4760: STOZ(p->i1,iq); nmtodp(mod,m1,&d); node = mknode(4,ONE,iq,d,ONE);
1.1 noro 4761: MKLIST(hist,node); MKNODE(nd_tracelist,hist,0);
1.6 noro 4762: STOZ(p->i2,iq); nmtodp(mod,m2,&d); node = mknode(4,ONE,iq,d,ONE);
1.1 noro 4763: MKLIST(hist,node); MKNODE(node,hist,nd_tracelist);
4764: nd_tracelist = node;
4765: }
4766: FREENM(m1); FREENM(m2);
4767: return 1;
4768: }
4769:
4770: void ndv_mul_c(int mod,NDV p,int mul)
4771: {
4772: NMV m;
4773: int c,c1,len,i;
4774:
4775: if ( !p ) return;
4776: len = LEN(p);
4777: if ( mod == -1 )
4778: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) )
4779: CM(m) = _mulsf(CM(m),mul);
4780: else
4781: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
4782: c1 = CM(m); DMAR(c1,mul,0,mod,c); CM(m) = c;
4783: }
4784: }
4785:
4786: void ndv_mul_c_lf(NDV p,Z mul)
4787: {
4788: NMV m;
4789: Z c;
4790: int len,i;
4791:
4792: if ( !p ) return;
4793: len = LEN(p);
4794: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
4795: mullf(CZ(m),mul,&c); CZ(m) = c;
4796: }
4797: }
4798:
4799: /* for nd_det */
4800: void ndv_mul_c_q(NDV p,Z mul)
4801: {
4802: NMV m;
4803: Z c;
4804: int len,i;
4805:
4806: if ( !p ) return;
4807: len = LEN(p);
4808: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
1.6 noro 4809: mulz(CZ(m),mul,&c); CZ(m) = c;
1.1 noro 4810: }
4811: }
4812:
4813: ND weyl_ndv_mul_nm(int mod,NM m0,NDV p) {
4814: int n2,i,j,l,n,tlen;
4815: UINT *d0;
4816: NM *tab,*psum;
4817: ND s,r;
4818: NM t;
4819: NMV m1;
4820:
4821: if ( !p ) return 0;
4822: n = NV(p); n2 = n>>1;
4823: d0 = DL(m0);
4824: l = LEN(p);
4825: for ( i = 0, tlen = 1; i < n2; i++ ) tlen *= (GET_EXP(d0,n2+i)+1);
4826: tab = (NM *)MALLOC(tlen*sizeof(NM));
4827: psum = (NM *)MALLOC(tlen*sizeof(NM));
4828: for ( i = 0; i < tlen; i++ ) psum[i] = 0;
4829: m1 = (NMV)(((char *)BDY(p))+nmv_adv*(l-1));
4830: for ( i = l-1; i >= 0; i--, NMV_PREV(m1) ) {
4831: /* m0(NM) * m1(NMV) => tab(NM) */
4832: weyl_mul_nm_nmv(n,mod,m0,m1,tab,tlen);
4833: for ( j = 0; j < tlen; j++ ) {
4834: if ( tab[j] ) {
4835: NEXT(tab[j]) = psum[j]; psum[j] = tab[j];
4836: }
4837: }
4838: }
4839: for ( i = tlen-1, r = 0; i >= 0; i-- )
4840: if ( psum[i] ) {
4841: for ( j = 0, t = psum[i]; t; t = NEXT(t), j++ );
4842: MKND(n,psum[i],j,s);
4843: r = nd_add(mod,r,s);
4844: }
4845: if ( r ) SG(r) = SG(p)+TD(d0);
4846: return r;
4847: }
4848:
4849: /* product of monomials */
4850: /* XXX block order is not handled correctly */
4851:
4852: void weyl_mul_nm_nmv(int n,int mod,NM m0,NMV m1,NM *tab,int tlen)
4853: {
4854: int i,n2,j,s,curlen,homo,h,a,b,k,l,u,min;
4855: UINT *d0,*d1,*d,*dt,*ctab;
4856: Z *ctab_q;
4857: Z q,q1;
4858: UINT c0,c1,c;
4859: NM *p;
4860: NM m,t;
4861: int mpos;
4862:
4863: for ( i = 0; i < tlen; i++ ) tab[i] = 0;
4864: if ( !m0 || !m1 ) return;
4865: d0 = DL(m0); d1 = DL(m1); n2 = n>>1;
4866: if ( nd_module )
4867: if ( MPOS(d0) ) error("weyl_mul_nm_nmv : invalid operation");
4868:
4869: NEWNM(m); d = DL(m);
4870: if ( mod ) {
4871: c0 = CM(m0); c1 = CM(m1); DMAR(c0,c1,0,mod,c); CM(m) = c;
4872: } else if ( nd_vc )
4873: mulp(nd_vc,CP(m0),CP(m1),&CP(m));
4874: else
1.6 noro 4875: mulz(CZ(m0),CZ(m1),&CZ(m));
1.1 noro 4876: for ( i = 0; i < nd_wpd; i++ ) d[i] = 0;
4877: homo = n&1 ? 1 : 0;
4878: if ( homo ) {
4879: /* offset of h-degree */
4880: h = GET_EXP(d0,n-1)+GET_EXP(d1,n-1);
4881: PUT_EXP(DL(m),n-1,h);
4882: TD(DL(m)) = h;
4883: if ( nd_blockmask ) ndl_weight_mask(DL(m));
4884: }
4885: tab[0] = m;
4886: NEWNM(m); d = DL(m);
4887: for ( i = 0, curlen = 1; i < n2; i++ ) {
4888: a = GET_EXP(d0,i); b = GET_EXP(d1,n2+i);
4889: k = GET_EXP(d0,n2+i); l = GET_EXP(d1,i);
4890: /* xi^a*(Di^k*xi^l)*Di^b */
4891: a += l; b += k;
4892: s = MUL_WEIGHT(a,i)+MUL_WEIGHT(b,n2+i);
4893: if ( !k || !l ) {
4894: for ( j = 0; j < curlen; j++ )
4895: if ( (t = tab[j]) != 0 ) {
4896: dt = DL(t);
4897: PUT_EXP(dt,i,a); PUT_EXP(dt,n2+i,b); TD(dt) += s;
4898: if ( nd_blockmask ) ndl_weight_mask(dt);
4899: }
4900: curlen *= k+1;
4901: continue;
4902: }
4903: min = MIN(k,l);
4904: if ( mod ) {
4905: ctab = (UINT *)MALLOC((min+1)*sizeof(UINT));
4906: mkwcm(k,l,mod,(int *)ctab);
4907: } else {
4908: ctab_q = (Z *)MALLOC((min+1)*sizeof(Z));
4909: mkwc(k,l,ctab_q);
4910: }
4911: for ( j = min; j >= 0; j-- ) {
4912: for ( u = 0; u < nd_wpd; u++ ) d[u] = 0;
4913: PUT_EXP(d,i,a-j); PUT_EXP(d,n2+i,b-j);
4914: h = MUL_WEIGHT(a-j,i)+MUL_WEIGHT(b-j,n2+i);
4915: if ( homo ) {
4916: TD(d) = s;
4917: PUT_EXP(d,n-1,s-h);
4918: } else TD(d) = h;
4919: if ( nd_blockmask ) ndl_weight_mask(d);
4920: if ( mod ) c = ctab[j];
4921: else q = ctab_q[j];
4922: p = tab+curlen*j;
4923: if ( j == 0 ) {
4924: for ( u = 0; u < curlen; u++, p++ ) {
4925: if ( tab[u] ) {
4926: ndl_addto(DL(tab[u]),d);
4927: if ( mod ) {
4928: c0 = CM(tab[u]); DMAR(c0,c,0,mod,c1); CM(tab[u]) = c1;
4929: } else if ( nd_vc )
4930: mulp(nd_vc,CP(tab[u]),(P)q,&CP(tab[u]));
4931: else {
1.6 noro 4932: mulz(CZ(tab[u]),q,&q1); CZ(tab[u]) = q1;
1.1 noro 4933: }
4934: }
4935: }
4936: } else {
4937: for ( u = 0; u < curlen; u++, p++ ) {
4938: if ( tab[u] ) {
4939: NEWNM(t);
4940: ndl_add(DL(tab[u]),d,DL(t));
4941: if ( mod ) {
4942: c0 = CM(tab[u]); DMAR(c0,c,0,mod,c1); CM(t) = c1;
4943: } else if ( nd_vc )
4944: mulp(nd_vc,CP(tab[u]),(P)q,&CP(t));
4945: else
1.6 noro 4946: mulz(CZ(tab[u]),q,&CZ(t));
1.1 noro 4947: *p = t;
4948: }
4949: }
4950: }
4951: }
4952: curlen *= k+1;
4953: }
4954: FREENM(m);
4955: if ( nd_module ) {
4956: mpos = MPOS(d1);
4957: for ( i = 0; i < tlen; i++ )
4958: if ( tab[i] ) {
4959: d = DL(tab[i]);
4960: MPOS(d) = mpos;
4961: TD(d) = ndl_weight(d);
4962: }
4963: }
4964: }
4965:
4966: ND ndv_mul_nm_symbolic(NM m0,NDV p)
4967: {
4968: NM mr,mr0;
4969: NMV m;
4970: UINT *d,*dt,*dm;
4971: int c,n,td,i,c1,c2,len;
4972: Q q;
4973: ND r;
4974:
4975: if ( !p ) return 0;
4976: else {
4977: n = NV(p); m = BDY(p);
4978: d = DL(m0);
4979: len = LEN(p);
4980: mr0 = 0;
4981: td = TD(d);
4982: c = CM(m0);
4983: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
4984: NEXTNM(mr0,mr);
4985: CM(mr) = 1;
4986: ndl_add(DL(m),d,DL(mr));
4987: }
4988: NEXT(mr) = 0;
4989: MKND(NV(p),mr0,len,r);
4990: SG(r) = SG(p) + TD(d);
4991: return r;
4992: }
4993: }
4994:
4995: ND ndv_mul_nm(int mod,NM m0,NDV p)
4996: {
4997: NM mr,mr0;
4998: NMV m;
4999: UINT *d,*dt,*dm;
5000: int c,n,td,i,c1,c2,len;
5001: P q;
5002: ND r;
5003:
5004: if ( !p ) return 0;
5005: else if ( do_weyl ) {
5006: if ( mod < 0 ) {
5007: error("ndv_mul_nm : not implemented (weyl)");
5008: return 0;
5009: } else
5010: return weyl_ndv_mul_nm(mod,m0,p);
5011: } else {
5012: n = NV(p); m = BDY(p);
5013: d = DL(m0);
5014: len = LEN(p);
5015: mr0 = 0;
5016: td = TD(d);
5017: if ( mod == -1 ) {
5018: c = CM(m0);
5019: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5020: NEXTNM(mr0,mr);
5021: CM(mr) = _mulsf(CM(m),c);
5022: ndl_add(DL(m),d,DL(mr));
5023: }
5024: } else if ( mod == -2 ) {
5025: Z cl;
5026: cl = CZ(m0);
5027: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5028: NEXTNM(mr0,mr);
5029: mullf(CZ(m),cl,&CZ(mr));
5030: ndl_add(DL(m),d,DL(mr));
5031: }
5032: } else if ( mod ) {
5033: c = CM(m0);
5034: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5035: NEXTNM(mr0,mr);
5036: c1 = CM(m);
5037: DMAR(c1,c,0,mod,c2);
5038: CM(mr) = c2;
5039: ndl_add(DL(m),d,DL(mr));
5040: }
5041: } else {
5042: q = CP(m0);
5043: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5044: NEXTNM(mr0,mr);
5045: mulp(nd_vc,CP(m),q,&CP(mr));
5046: ndl_add(DL(m),d,DL(mr));
5047: }
5048: }
5049: NEXT(mr) = 0;
5050: MKND(NV(p),mr0,len,r);
5051: SG(r) = SG(p) + TD(d);
5052: return r;
5053: }
5054: }
5055:
5056: ND nd_quo(int mod,PGeoBucket bucket,NDV d)
5057: {
5058: NM mq0,mq;
5059: NMV tm;
5060: Q q;
5061: int i,nv,sg,c,c1,c2,hindex;
5062: ND p,t,r;
5063:
5064: if ( bucket->m < 0 ) return 0;
5065: else {
5066: nv = NV(d);
5067: mq0 = 0;
5068: tm = (NMV)MALLOC(nmv_adv);
5069: while ( 1 ) {
5070: if ( mod > 0 || mod == -1 )
5071: hindex = head_pbucket(mod,bucket);
5072: else if ( mod == -2 )
5073: hindex = head_pbucket_lf(bucket);
5074: else
5075: hindex = head_pbucket_q(bucket);
5076: if ( hindex < 0 ) break;
5077: p = bucket->body[hindex];
5078: NEXTNM(mq0,mq);
5079: ndl_sub(HDL(p),HDL(d),DL(mq));
5080: ndl_copy(DL(mq),DL(tm));
5081: if ( mod ) {
5082: c1 = invm(HCM(d),mod); c2 = HCM(p);
5083: DMAR(c1,c2,0,mod,c); CM(mq) = c;
5084: CM(tm) = mod-c;
5085: } else {
1.6 noro 5086: divsz(HCZ(p),HCZ(d),&CZ(mq));
5087: chsgnz(CZ(mq),&CZ(tm));
1.1 noro 5088: }
5089: t = ndv_mul_nmv_trunc(mod,tm,d,HDL(d));
5090: bucket->body[hindex] = nd_remove_head(p);
5091: t = nd_remove_head(t);
5092: add_pbucket(mod,bucket,t);
5093: }
5094: if ( !mq0 )
5095: r = 0;
5096: else {
5097: NEXT(mq) = 0;
5098: for ( i = 0, mq = mq0; mq; mq = NEXT(mq), i++ );
5099: MKND(nv,mq0,i,r);
5100: /* XXX */
5101: SG(r) = HTD(r);
5102: }
5103: return r;
5104: }
5105: }
5106:
5107: void ndv_realloc(NDV p,int obpe,int oadv,EPOS oepos)
5108: {
5109: NMV m,mr,mr0,t;
5110: int len,i,k;
5111:
5112: if ( !p ) return;
5113: m = BDY(p); len = LEN(p);
5114: mr0 = nmv_adv>oadv?(NMV)REALLOC(BDY(p),len*nmv_adv):BDY(p);
5115: m = (NMV)((char *)mr0+(len-1)*oadv);
5116: mr = (NMV)((char *)mr0+(len-1)*nmv_adv);
5117: t = (NMV)MALLOC(nmv_adv);
5118: for ( i = 0; i < len; i++, NMV_OPREV(m), NMV_PREV(mr) ) {
1.6 noro 5119: CZ(t) = CZ(m);
1.1 noro 5120: for ( k = 0; k < nd_wpd; k++ ) DL(t)[k] = 0;
5121: ndl_reconstruct(DL(m),DL(t),obpe,oepos);
1.6 noro 5122: CZ(mr) = CZ(t);
1.1 noro 5123: ndl_copy(DL(t),DL(mr));
5124: }
5125: BDY(p) = mr0;
5126: }
5127:
5128: NDV ndv_dup_realloc(NDV p,int obpe,int oadv,EPOS oepos)
5129: {
5130: NMV m,mr,mr0;
5131: int len,i;
5132: NDV r;
5133:
5134: if ( !p ) return 0;
5135: m = BDY(p); len = LEN(p);
5136: mr0 = mr = (NMV)MALLOC(len*nmv_adv);
5137: for ( i = 0; i < len; i++, NMV_OADV(m), NMV_ADV(mr) ) {
5138: ndl_zero(DL(mr));
5139: ndl_reconstruct(DL(m),DL(mr),obpe,oepos);
1.6 noro 5140: CZ(mr) = CZ(m);
1.1 noro 5141: }
5142: MKNDV(NV(p),mr0,len,r);
5143: SG(r) = SG(p);
5144: return r;
5145: }
5146:
5147: /* duplicate p */
5148:
5149: NDV ndv_dup(int mod,NDV p)
5150: {
5151: NDV d;
5152: NMV t,m,m0;
5153: int i,len;
5154:
5155: if ( !p ) return 0;
5156: len = LEN(p);
5157: m0 = m = (NMV)((mod>0 || mod==-1)?MALLOC_ATOMIC(len*nmv_adv):MALLOC(len*nmv_adv));
5158: for ( t = BDY(p), i = 0; i < len; i++, NMV_ADV(t), NMV_ADV(m) ) {
5159: ndl_copy(DL(t),DL(m));
1.6 noro 5160: CZ(m) = CZ(t);
1.1 noro 5161: }
5162: MKNDV(NV(p),m0,len,d);
5163: SG(d) = SG(p);
5164: return d;
5165: }
5166:
5167: NDV ndv_symbolic(int mod,NDV p)
5168: {
5169: NDV d;
5170: NMV t,m,m0;
5171: int i,len;
5172:
5173: if ( !p ) return 0;
5174: len = LEN(p);
5175: m0 = m = (NMV)((mod>0||mod==-1)?MALLOC_ATOMIC(len*nmv_adv):MALLOC(len*nmv_adv));
5176: for ( t = BDY(p), i = 0; i < len; i++, NMV_ADV(t), NMV_ADV(m) ) {
5177: ndl_copy(DL(t),DL(m));
1.6 noro 5178: CZ(m) = ONE;
1.1 noro 5179: }
5180: MKNDV(NV(p),m0,len,d);
5181: SG(d) = SG(p);
5182: return d;
5183: }
5184:
5185: ND nd_dup(ND p)
5186: {
5187: ND d;
5188: NM t,m,m0;
5189:
5190: if ( !p ) return 0;
5191: for ( m0 = 0, t = BDY(p); t; t = NEXT(t) ) {
5192: NEXTNM(m0,m);
5193: ndl_copy(DL(t),DL(m));
1.6 noro 5194: CZ(m) = CZ(t);
1.1 noro 5195: }
5196: if ( m0 ) NEXT(m) = 0;
5197: MKND(NV(p),m0,LEN(p),d);
5198: SG(d) = SG(p);
5199: return d;
5200: }
5201:
5202: /* XXX if p->len == 0 then it represents 0 */
5203:
5204: void ndv_mod(int mod,NDV p)
5205: {
5206: NMV t,d;
5207: int r,s,u;
5208: int i,len,dlen;
5209: P cp;
5210: Z c;
5211: Obj gfs;
5212:
5213: if ( !p ) return;
5214: len = LEN(p);
5215: dlen = 0;
5216: if ( mod == -1 )
5217: for ( t = d = BDY(p), i = 0; i < len; i++, NMV_ADV(t) ) {
5218: simp_ff((Obj)CP(t),&gfs);
5219: if ( gfs ) {
5220: r = FTOIF(CONT((GFS)gfs));
5221: CM(d) = r;
5222: ndl_copy(DL(t),DL(d));
5223: NMV_ADV(d);
5224: dlen++;
5225: }
5226: }
5227: else if ( mod == -2 )
5228: for ( t = d = BDY(p), i = 0; i < len; i++, NMV_ADV(t) ) {
5229: simp_ff((Obj)CP(t),&gfs);
5230: if ( gfs ) {
5231: lmtolf((LM)gfs,&CZ(d));
5232: ndl_copy(DL(t),DL(d));
5233: NMV_ADV(d);
5234: dlen++;
5235: }
5236: }
5237: else
5238: for ( t = d = BDY(p), i = 0; i < len; i++, NMV_ADV(t) ) {
5239: if ( nd_vc ) {
5240: nd_subst_vector(nd_vc,CP(t),nd_subst,&cp);
5241: c = (Z)cp;
5242: } else
1.6 noro 5243: c = CZ(t);
1.1 noro 5244: r = remqi((Q)c,mod);
5245: if ( r ) {
5246: CM(d) = r;
5247: ndl_copy(DL(t),DL(d));
5248: NMV_ADV(d);
5249: dlen++;
5250: }
5251: }
5252: LEN(p) = dlen;
5253: }
5254:
5255: NDV ptondv(VL vl,VL dvl,P p)
5256: {
5257: ND nd;
5258:
5259: nd = ptond(vl,dvl,p);
5260: return ndtondv(0,nd);
5261: }
5262:
5263: void pltozpl(LIST l,Q *cont,LIST *pp)
5264: {
1.16 noro 5265: NODE nd,nd1;
5266: int n;
5267: P *pl;
5268: Q *cl;
5269: int i;
5270: P dmy;
5271: Z dvr,inv;
5272: LIST r;
5273:
5274: nd = BDY(l); n = length(nd);
5275: pl = (P *)MALLOC(n*sizeof(P));
5276: cl = (Q *)MALLOC(n*sizeof(Q));
5277: for ( i = 0; i < n; i++, nd = NEXT(nd) ) {
5278: ptozp((P)BDY(nd),1,&cl[i],&dmy);
5279: }
5280: qltozl(cl,n,&dvr);
5281: divz(ONE,dvr,&inv);
5282: nd = BDY(l);
5283: for ( i = 0; i < n; i++, nd = NEXT(nd) )
5284: divsp(CO,(P)BDY(nd),(P)dvr,&pl[i]);
5285: nd = 0;
5286: for ( i = n-1; i >= 0; i-- ) {
5287: MKNODE(nd1,pl[i],nd); nd = nd1;
5288: }
5289: MKLIST(r,nd);
5290: *pp = r;
1.1 noro 5291: }
5292:
5293: /* (a1,a2,...,an) -> a1*e(1)+...+an*e(n) */
5294:
5295: NDV pltondv(VL vl,VL dvl,LIST p)
5296: {
5297: int i;
5298: NODE t;
5299: ND r,ri;
5300: NM m;
5301:
5302: if ( !nd_module ) error("pltond : module order must be set");
5303: r = 0;
5304: for ( i = 1, t = BDY(p); t; t = NEXT(t), i++ ) {
5305: ri = ptond(vl,dvl,(P)BDY(t));
5306: if ( ri )
5307: for ( m = BDY(ri); m; m = NEXT(m) ) {
5308: MPOS(DL(m)) = i;
5309: TD(DL(m)) = ndl_weight(DL(m));
5310: if ( nd_blockmask ) ndl_weight_mask(DL(m));
5311: }
5312: r = nd_add(0,r,ri);
5313: }
5314: return ndtondv(0,r);
5315: }
5316:
5317: ND ptond(VL vl,VL dvl,P p)
5318: {
5319: int n,i,j,k,e;
5320: VL tvl;
5321: V v;
5322: DCP dc;
5323: DCP *w;
5324: ND r,s,t,u;
5325: P x;
5326: int c;
5327: UINT *d;
5328: NM m,m0;
5329:
5330: if ( !p )
5331: return 0;
5332: else if ( NUM(p) ) {
5333: NEWNM(m);
5334: ndl_zero(DL(m));
5335: if ( !INT((Q)p) )
5336: error("ptond : input must be integer-coefficient");
1.6 noro 5337: CZ(m) = (Z)p;
1.1 noro 5338: NEXT(m) = 0;
5339: MKND(nd_nvar,m,1,r);
5340: SG(r) = 0;
5341: return r;
5342: } else {
5343: for ( dc = DC(p), k = 0; dc; dc = NEXT(dc), k++ );
5344: w = (DCP *)MALLOC(k*sizeof(DCP));
5345: for ( dc = DC(p), j = 0; j < k; dc = NEXT(dc), j++ ) w[j] = dc;
5346: for ( i = 0, tvl = dvl, v = VR(p);
5347: tvl && tvl->v != v; tvl = NEXT(tvl), i++ );
5348: if ( !tvl ) {
5349: for ( j = k-1, s = 0, MKV(v,x); j >= 0; j-- ) {
5350: t = ptond(vl,dvl,COEF(w[j]));
5351: pwrp(vl,x,DEG(w[j]),&p);
5352: nd_mul_c_p(CO,t,p); s = nd_add(0,s,t);
5353: }
5354: return s;
5355: } else {
5356: NEWNM(m0); d = DL(m0);
5357: for ( j = k-1, s = 0; j >= 0; j-- ) {
1.6 noro 5358: ndl_zero(d); e = ZTOS(DEG(w[j])); PUT_EXP(d,i,e);
1.1 noro 5359: TD(d) = MUL_WEIGHT(e,i);
5360: if ( nd_blockmask) ndl_weight_mask(d);
5361: if ( nd_module ) MPOS(d) = 0;
5362: t = ptond(vl,dvl,COEF(w[j]));
5363: for ( m = BDY(t); m; m = NEXT(m) )
5364: ndl_addto(DL(m),d);
5365: SG(t) += TD(d);
5366: s = nd_add(0,s,t);
5367: }
5368: FREENM(m0);
5369: return s;
5370: }
5371: }
5372: }
5373:
5374: P ndvtop(int mod,VL vl,VL dvl,NDV p)
5375: {
5376: VL tvl;
5377: int len,n,j,i,e;
5378: NMV m;
5379: Z q;
5380: P c;
5381: UINT *d;
5382: P s,r,u,t,w;
5383: GFS gfs;
5384:
5385: if ( !p ) return 0;
5386: else {
5387: len = LEN(p);
5388: n = NV(p);
5389: m = (NMV)(((char *)BDY(p))+nmv_adv*(len-1));
5390: for ( j = len-1, s = 0; j >= 0; j--, NMV_PREV(m) ) {
5391: if ( mod == -1 ) {
5392: e = IFTOF(CM(m)); MKGFS(e,gfs); c = (P)gfs;
5393: } else if ( mod == -2 ) {
5394: c = (P)CZ(m);
5395: } else if ( mod > 0 ) {
1.6 noro 5396: STOZ(CM(m),q); c = (P)q;
1.1 noro 5397: } else
5398: c = CP(m);
5399: d = DL(m);
5400: for ( i = 0, t = c, tvl = dvl; i < n; tvl = NEXT(tvl), i++ ) {
1.6 noro 5401: MKV(tvl->v,r); e = GET_EXP(d,i); STOZ(e,q);
1.1 noro 5402: pwrp(vl,r,q,&u); mulp(vl,t,u,&w); t = w;
5403: }
5404: addp(vl,s,t,&u); s = u;
5405: }
5406: return s;
5407: }
5408: }
5409:
5410: LIST ndvtopl(int mod,VL vl,VL dvl,NDV p,int rank)
5411: {
5412: VL tvl;
5413: int len,n,j,i,e;
5414: NMV m;
5415: Z q;
5416: P c;
5417: UINT *d;
5418: P s,r,u,t,w;
5419: GFS gfs;
5420: P *a;
5421: LIST l;
5422: NODE nd,nd1;
5423:
5424: if ( !p ) return 0;
5425: else {
5426: a = (P *)MALLOC((rank+1)*sizeof(P));
5427: for ( i = 0; i <= rank; i++ ) a[i] = 0;
5428: len = LEN(p);
5429: n = NV(p);
5430: m = (NMV)(((char *)BDY(p))+nmv_adv*(len-1));
5431: for ( j = len-1; j >= 0; j--, NMV_PREV(m) ) {
5432: if ( mod == -1 ) {
5433: e = IFTOF(CM(m)); MKGFS(e,gfs); c = (P)gfs;
5434: } else if ( mod ) {
1.6 noro 5435: STOZ(CM(m),q); c = (P)q;
1.1 noro 5436: } else
5437: c = CP(m);
5438: d = DL(m);
5439: for ( i = 0, t = c, tvl = dvl; i < n; tvl = NEXT(tvl), i++ ) {
1.6 noro 5440: MKV(tvl->v,r); e = GET_EXP(d,i); STOZ(e,q);
1.1 noro 5441: pwrp(vl,r,q,&u); mulp(vl,t,u,&w); t = w;
5442: }
5443: addp(vl,a[MPOS(d)],t,&u); a[MPOS(d)] = u;
5444: }
5445: nd = 0;
5446: for ( i = rank; i > 0; i-- ) {
5447: MKNODE(nd1,a[i],nd); nd = nd1;
5448: }
5449: MKLIST(l,nd);
5450: return l;
5451: }
5452: }
5453:
5454: NDV ndtondv(int mod,ND p)
5455: {
5456: NDV d;
5457: NMV m,m0;
5458: NM t;
5459: int i,len;
5460:
5461: if ( !p ) return 0;
5462: len = LEN(p);
5463: if ( mod > 0 || mod == -1 )
5464: m0 = m = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(len*nmv_adv);
5465: else
5466: m0 = m = MALLOC(len*nmv_adv);
5467: #if 0
5468: ndv_alloc += nmv_adv*len;
5469: #endif
5470: for ( t = BDY(p), i = 0; t; t = NEXT(t), i++, NMV_ADV(m) ) {
5471: ndl_copy(DL(t),DL(m));
1.6 noro 5472: CZ(m) = CZ(t);
1.1 noro 5473: }
5474: MKNDV(NV(p),m0,len,d);
5475: SG(d) = SG(p);
5476: return d;
5477: }
5478:
1.16 noro 5479: static int dmm_comp_nv;
5480:
5481: int dmm_comp(DMM *a,DMM *b)
5482: {
5483: return -compdmm(dmm_comp_nv,*a,*b);
5484: }
5485:
5486: void dmm_sort_by_ord(DMM *a,int len,int nv)
5487: {
5488: dmm_comp_nv = nv;
5489: qsort(a,len,sizeof(DMM),(int (*)(const void *,const void *))dmm_comp);
5490: }
5491:
5492: void dpm_sort(DPM p,DPM *rp)
5493: {
5494: DMM t,t1;
5495: int len,i,n;
5496: DMM *a;
5497: DPM d;
5498:
5499: if ( !p ) *rp = 0;
5500: for ( t = BDY(p), len = 0; t; t = NEXT(t), len++ );
5501: a = (DMM *)MALLOC(len*sizeof(DMM));
5502: for ( i = 0, t = BDY(p); i < len; i++, t = NEXT(t) ) a[i] = t;
5503: n = p->nv;
5504: dmm_sort_by_ord(a,len,n);
5505: t = 0;
5506: for ( i = len-1; i >= 0; i-- ) {
5507: NEWDMM(t1);
5508: t1->c = a[i]->c;
5509: t1->dl = a[i]->dl;
5510: t1->pos = a[i]->pos;
5511: t1->next = t;
5512: t = t1;
5513: }
5514: MKDPM(n,t,d);
5515: SG(d) = SG(p);
5516: *rp = d;
5517: }
5518:
1.18 noro 5519: int dpm_comp(DPM *a,DPM *b)
5520: {
5521: return compdpm(CO,*a,*b);
5522: }
5523:
5524: NODE dpm_sort_list(NODE l)
5525: {
5526: int i,len;
5527: NODE t,t1;
5528: DPM *a;
5529:
5530: len = length(l);
5531: a = (DPM *)MALLOC(len*sizeof(DPM));
5532: for ( t = l, i = 0; i < len; i++, t = NEXT(t) ) a[i] = (DPM)BDY(t);
5533: qsort(a,len,sizeof(DPM),(int (*)(const void *,const void *))dpm_comp);
5534: t = 0;
5535: for ( i = len-1; i >= 0; i-- ) {
5536: MKNODE(t1,(pointer)a[i],t); t = t1;
5537: }
5538: return t;
5539: }
5540:
1.16 noro 5541: NDV dpmtondv(int mod,DPM p)
5542: {
5543: NDV d;
5544: NMV m,m0;
5545: DMM t;
5546: DMM *a;
5547: int i,len,n;
5548:
5549: if ( !p ) return 0;
5550: for ( t = BDY(p), len = 0; t; t = NEXT(t), len++ );
5551: a = (DMM *)MALLOC(len*sizeof(DMM));
5552: for ( i = 0, t = BDY(p); i < len; i++, t = NEXT(t) ) a[i] = t;
5553: n = p->nv;
5554: dmm_sort_by_ord(a,len,n);
5555: if ( mod > 0 || mod == -1 )
5556: m0 = m = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(len*nmv_adv);
5557: else
5558: m0 = m = MALLOC(len*nmv_adv);
5559: #if 0
5560: ndv_alloc += nmv_adv*len;
5561: #endif
5562: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5563: dltondl(n,a[i]->dl,DL(m));
5564: MPOS(DL(m)) = a[i]->pos;
5565: CZ(m) = (Z)a[i]->c;
5566: }
5567: MKNDV(NV(p),m0,len,d);
5568: SG(d) = SG(p);
5569: return d;
5570: }
5571:
1.1 noro 5572: ND ndvtond(int mod,NDV p)
5573: {
5574: ND d;
5575: NM m,m0;
5576: NMV t;
5577: int i,len;
5578:
5579: if ( !p ) return 0;
5580: m0 = 0;
5581: len = p->len;
5582: for ( t = BDY(p), i = 0; i < len; NMV_ADV(t), i++ ) {
5583: NEXTNM(m0,m);
5584: ndl_copy(DL(t),DL(m));
1.6 noro 5585: CZ(m) = CZ(t);
1.1 noro 5586: }
5587: NEXT(m) = 0;
5588: MKND(NV(p),m0,len,d);
5589: SG(d) = SG(p);
5590: return d;
5591: }
5592:
5593: DP ndvtodp(int mod,NDV p)
5594: {
5595: MP m,m0;
5596: DP d;
5597: NMV t;
5598: int i,len;
5599:
5600: if ( !p ) return 0;
5601: m0 = 0;
5602: len = p->len;
5603: for ( t = BDY(p), i = 0; i < len; NMV_ADV(t), i++ ) {
5604: NEXTMP(m0,m);
5605: m->dl = ndltodl(nd_nvar,DL(t));
5606: m->c = (Obj)ndctop(mod,t->c);
5607: }
5608: NEXT(m) = 0;
5609: MKDP(nd_nvar,m0,d);
5610: SG(d) = SG(p);
5611: return d;
5612: }
5613:
1.16 noro 5614: DPM ndvtodpm(int mod,NDV p)
5615: {
5616: DMM m,m0;
5617: DPM d;
5618: NMV t;
5619: int i,len;
5620:
5621: if ( !p ) return 0;
5622: m0 = 0;
5623: len = p->len;
5624: for ( t = BDY(p), i = 0; i < len; NMV_ADV(t), i++ ) {
5625: NEXTDMM(m0,m);
5626: m->dl = ndltodl(nd_nvar,DL(t));
5627: m->c = (Obj)ndctop(mod,t->c);
5628: m->pos = MPOS(DL(t));
5629: }
5630: NEXT(m) = 0;
5631: MKDPM(nd_nvar,m0,d);
5632: SG(d) = SG(p);
5633: return d;
5634: }
5635:
5636:
1.1 noro 5637: DP ndtodp(int mod,ND p)
5638: {
5639: MP m,m0;
5640: DP d;
5641: NM t;
5642: int i,len;
5643:
5644: if ( !p ) return 0;
5645: m0 = 0;
5646: len = p->len;
5647: for ( t = BDY(p); t; t = NEXT(t) ) {
5648: NEXTMP(m0,m);
5649: m->dl = ndltodl(nd_nvar,DL(t));
5650: m->c = (Obj)ndctop(mod,t->c);
5651: }
5652: NEXT(m) = 0;
5653: MKDP(nd_nvar,m0,d);
5654: SG(d) = SG(p);
5655: return d;
5656: }
5657:
5658: void ndv_print(NDV p)
5659: {
5660: NMV m;
5661: int i,len;
5662:
5663: if ( !p ) printf("0\n");
5664: else {
5665: len = LEN(p);
5666: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
5667: if ( CM(m) & 0x80000000 ) printf("+@_%d*",IFTOF(CM(m)));
5668: else printf("+%d*",CM(m));
5669: ndl_print(DL(m));
5670: }
5671: printf("\n");
5672: }
5673: }
5674:
5675: void ndv_print_q(NDV p)
5676: {
5677: NMV m;
5678: int i,len;
5679:
5680: if ( !p ) printf("0\n");
5681: else {
5682: len = LEN(p);
5683: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
5684: printf("+");
1.6 noro 5685: printexpr(CO,(Obj)CZ(m));
1.1 noro 5686: printf("*");
5687: ndl_print(DL(m));
5688: }
5689: printf("\n");
5690: }
5691: }
5692:
5693: NODE ndv_reducebase(NODE x,int *perm)
5694: {
5695: int len,i,j;
5696: NDVI w;
5697: NODE t,t0;
5698:
5699: len = length(x);
5700: w = (NDVI)MALLOC(len*sizeof(struct oNDVI));
5701: for ( i = 0, t = x; i < len; i++, t = NEXT(t) ) {
5702: w[i].p = BDY(t); w[i].i = perm[i];
5703: }
5704: for ( i = 0; i < len; i++ ) {
5705: for ( j = 0; j < i; j++ ) {
5706: if ( w[i].p && w[j].p ) {
5707: if ( ndl_reducible(HDL(w[i].p),HDL(w[j].p)) ) w[i].p = 0;
5708: else if ( ndl_reducible(HDL(w[j].p),HDL(w[i].p)) ) w[j].p = 0;
5709: }
5710: }
5711: }
5712: for ( i = j = 0, t0 = 0; i < len; i++ ) {
5713: if ( w[i].p ) {
5714: NEXTNODE(t0,t); BDY(t) = (pointer)w[i].p;
5715: perm[j++] = w[i].i;
5716: }
5717: }
5718: NEXT(t) = 0; x = t0;
5719: return x;
5720: }
5721:
5722: /* XXX incomplete */
5723:
1.16 noro 5724: extern int dpm_ordtype;
5725:
1.1 noro 5726: void nd_init_ord(struct order_spec *ord)
5727: {
5728: nd_module = (ord->id >= 256);
5729: if ( nd_module ) {
5730: nd_dcomp = -1;
5731: nd_ispot = ord->ispot;
5732: nd_pot_nelim = ord->pot_nelim;
5733: nd_poly_weight_len = ord->nv;
5734: nd_poly_weight = ord->top_weight;
5735: nd_module_rank = ord->module_rank;
5736: nd_module_weight = ord->module_top_weight;
1.16 noro 5737: dpm_ordtype = ord->ispot;
1.1 noro 5738: }
5739: nd_matrix = 0;
5740: nd_matrix_len = 0;
5741: switch ( ord->id ) {
5742: case 0:
5743: switch ( ord->ord.simple ) {
5744: case 0:
5745: nd_dcomp = 1;
5746: nd_isrlex = 1;
5747: break;
5748: case 1:
5749: nd_dcomp = 1;
5750: nd_isrlex = 0;
5751: break;
5752: case 2:
5753: nd_dcomp = 0;
5754: nd_isrlex = 0;
5755: ndl_compare_function = ndl_lex_compare;
5756: break;
5757: case 11:
5758: /* XXX */
5759: nd_dcomp = 0;
5760: nd_isrlex = 1;
5761: ndl_compare_function = ndl_ww_lex_compare;
5762: break;
5763: default:
5764: error("nd_gr : unsupported order");
5765: }
5766: break;
5767: case 1:
5768: /* block order */
5769: /* XXX */
5770: nd_dcomp = -1;
5771: nd_isrlex = 0;
5772: ndl_compare_function = ndl_block_compare;
5773: break;
5774: case 2:
5775: /* matrix order */
5776: /* XXX */
5777: nd_dcomp = -1;
5778: nd_isrlex = 0;
5779: nd_matrix_len = ord->ord.matrix.row;
5780: nd_matrix = ord->ord.matrix.matrix;
5781: ndl_compare_function = ndl_matrix_compare;
5782: break;
5783: case 3:
5784: /* composite order */
5785: nd_dcomp = -1;
5786: nd_isrlex = 0;
5787: nd_worb_len = ord->ord.composite.length;
5788: nd_worb = ord->ord.composite.w_or_b;
5789: ndl_compare_function = ndl_composite_compare;
5790: break;
5791:
5792: /* module order */
5793: case 256:
5794: switch ( ord->ord.simple ) {
5795: case 0:
5796: nd_isrlex = 1;
5797: ndl_compare_function = ndl_module_grlex_compare;
5798: break;
5799: case 1:
5800: nd_isrlex = 0;
5801: ndl_compare_function = ndl_module_glex_compare;
5802: break;
5803: case 2:
5804: nd_isrlex = 0;
5805: ndl_compare_function = ndl_module_lex_compare;
5806: break;
5807: default:
5808: error("nd_gr : unsupported order");
5809: }
5810: break;
5811: case 257:
5812: /* block order */
5813: nd_isrlex = 0;
5814: ndl_compare_function = ndl_module_block_compare;
5815: break;
5816: case 258:
5817: /* matrix order */
5818: nd_isrlex = 0;
5819: nd_matrix_len = ord->ord.matrix.row;
5820: nd_matrix = ord->ord.matrix.matrix;
5821: ndl_compare_function = ndl_module_matrix_compare;
5822: break;
5823: case 259:
5824: /* composite order */
5825: nd_isrlex = 0;
5826: nd_worb_len = ord->ord.composite.length;
5827: nd_worb = ord->ord.composite.w_or_b;
5828: ndl_compare_function = ndl_module_composite_compare;
5829: break;
5830: }
5831: nd_ord = ord;
5832: }
5833:
5834: BlockMask nd_create_blockmask(struct order_spec *ord)
5835: {
5836: int n,i,j,s,l;
5837: UINT *t;
5838: BlockMask bm;
5839:
5840: /* we only create mask table for block order */
5841: if ( ord->id != 1 && ord->id != 257 )
5842: return 0;
5843: n = ord->ord.block.length;
5844: bm = (BlockMask)MALLOC(sizeof(struct oBlockMask));
5845: bm->n = n;
5846: bm->order_pair = ord->ord.block.order_pair;
5847: bm->mask = (UINT **)MALLOC(n*sizeof(UINT *));
5848: for ( i = 0, s = 0; i < n; i++ ) {
5849: bm->mask[i] = t = (UINT *)MALLOC_ATOMIC(nd_wpd*sizeof(UINT));
5850: for ( j = 0; j < nd_wpd; j++ ) t[j] = 0;
5851: l = bm->order_pair[i].length;
5852: for ( j = 0; j < l; j++, s++ ) PUT_EXP(t,s,nd_mask0);
5853: }
5854: return bm;
5855: }
5856:
5857: EPOS nd_create_epos(struct order_spec *ord)
5858: {
5859: int i,j,l,s,ord_l,ord_o;
5860: EPOS epos;
5861: struct order_pair *op;
5862:
5863: epos = (EPOS)MALLOC_ATOMIC(nd_nvar*sizeof(struct oEPOS));
5864: switch ( ord->id ) {
5865: case 0: case 256:
5866: if ( nd_isrlex ) {
5867: for ( i = 0; i < nd_nvar; i++ ) {
5868: epos[i].i = nd_exporigin + (nd_nvar-1-i)/nd_epw;
5869: epos[i].s = (nd_epw-((nd_nvar-1-i)%nd_epw)-1)*nd_bpe;
5870: }
5871: } else {
5872: for ( i = 0; i < nd_nvar; i++ ) {
5873: epos[i].i = nd_exporigin + i/nd_epw;
5874: epos[i].s = (nd_epw-(i%nd_epw)-1)*nd_bpe;
5875: }
5876: }
5877: break;
5878: case 1: case 257:
5879: /* block order */
5880: l = ord->ord.block.length;
5881: op = ord->ord.block.order_pair;
5882: for ( j = 0, s = 0; j < l; j++ ) {
5883: ord_o = op[j].order;
5884: ord_l = op[j].length;
5885: if ( !ord_o )
5886: for ( i = 0; i < ord_l; i++ ) {
5887: epos[s+i].i = nd_exporigin + (s+ord_l-i-1)/nd_epw;
5888: epos[s+i].s = (nd_epw-((s+ord_l-i-1)%nd_epw)-1)*nd_bpe;
5889: }
5890: else
5891: for ( i = 0; i < ord_l; i++ ) {
5892: epos[s+i].i = nd_exporigin + (s+i)/nd_epw;
5893: epos[s+i].s = (nd_epw-((s+i)%nd_epw)-1)*nd_bpe;
5894: }
5895: s += ord_l;
5896: }
5897: break;
5898: case 2:
5899: /* matrix order */
5900: case 3:
5901: /* composite order */
5902: default:
5903: for ( i = 0; i < nd_nvar; i++ ) {
5904: epos[i].i = nd_exporigin + i/nd_epw;
5905: epos[i].s = (nd_epw-(i%nd_epw)-1)*nd_bpe;
5906: }
5907: break;
5908: }
5909: return epos;
5910: }
5911:
5912: /* external interface */
5913:
5914: void nd_nf_p(Obj f,LIST g,LIST v,int m,struct order_spec *ord,Obj *rp)
5915: {
5916: NODE t,in0,in;
5917: ND ndf,nf;
5918: NDV ndvf;
5919: VL vv,tv;
5920: int stat,nvar,max,mrank;
5921: union oNDC dn;
5922: Q cont;
5923: P pp;
5924: LIST ppl;
5925:
5926: if ( !f ) {
5927: *rp = 0;
5928: return;
5929: }
5930: pltovl(v,&vv);
5931: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
5932:
5933: /* max=65536 implies nd_bpe=32 */
5934: max = 65536;
5935:
5936: nd_module = 0;
5937: /* nd_module will be set if ord is a module ordering */
5938: nd_init_ord(ord);
5939: nd_setup_parameters(nvar,max);
5940: if ( nd_module && OID(f) != O_LIST )
5941: error("nd_nf_p : the first argument must be a list");
5942: if ( nd_module ) mrank = length(BDY((LIST)f));
5943: /* conversion to ndv */
5944: for ( in0 = 0, t = BDY(g); t; t = NEXT(t) ) {
5945: NEXTNODE(in0,in);
5946: if ( nd_module ) {
5947: if ( !BDY(t) || OID(BDY(t)) != O_LIST
5948: || length(BDY((LIST)BDY(t))) != mrank )
5949: error("nd_nf_p : inconsistent basis element");
5950: if ( !m ) pltozpl((LIST)BDY(t),&cont,&ppl);
5951: else ppl = (LIST)BDY(t);
5952: BDY(in) = (pointer)pltondv(CO,vv,ppl);
5953: } else {
5954: if ( !m ) ptozp((P)BDY(t),1,&cont,&pp);
5955: else pp = (P)BDY(t);
5956: BDY(in) = (pointer)ptondv(CO,vv,pp);
5957: }
5958: if ( m ) ndv_mod(m,(NDV)BDY(in));
5959: }
5960: if ( in0 ) NEXT(in) = 0;
5961:
5962: if ( nd_module ) ndvf = pltondv(CO,vv,(LIST)f);
5963: else ndvf = ptondv(CO,vv,(P)f);
5964: if ( m ) ndv_mod(m,ndvf);
5965: ndf = (pointer)ndvtond(m,ndvf);
5966:
5967: /* dont sort, dont removecont */
5968: ndv_setup(m,0,in0,1,1);
5969: nd_scale=2;
1.6 noro 5970: stat = nd_nf(m,0,ndf,nd_ps,1,&nf);
1.1 noro 5971: if ( !stat )
5972: error("nd_nf_p : exponent too large");
5973: if ( nd_module ) *rp = (Obj)ndvtopl(m,CO,vv,ndtondv(m,nf),mrank);
5974: else *rp = (Obj)ndvtop(m,CO,vv,ndtondv(m,nf));
5975: }
5976:
5977: int nd_to_vect(int mod,UINT *s0,int n,ND d,UINT *r)
5978: {
5979: NM m;
5980: UINT *t,*s;
5981: int i;
5982:
5983: for ( i = 0; i < n; i++ ) r[i] = 0;
5984: for ( i = 0, s = s0, m = BDY(d); m; m = NEXT(m) ) {
5985: t = DL(m);
5986: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
5987: r[i] = CM(m);
5988: }
5989: for ( i = 0; !r[i]; i++ );
5990: return i;
5991: }
5992:
5993: int nd_to_vect_q(UINT *s0,int n,ND d,Z *r)
5994: {
5995: NM m;
5996: UINT *t,*s;
5997: int i;
5998:
5999: for ( i = 0; i < n; i++ ) r[i] = 0;
6000: for ( i = 0, s = s0, m = BDY(d); m; m = NEXT(m) ) {
6001: t = DL(m);
6002: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
1.6 noro 6003: r[i] = CZ(m);
1.1 noro 6004: }
6005: for ( i = 0; !r[i]; i++ );
6006: return i;
6007: }
6008:
6009: int nd_to_vect_lf(UINT *s0,int n,ND d,mpz_t *r)
6010: {
6011: NM m;
6012: UINT *t,*s;
6013: int i;
6014:
6015: for ( i = 0; i < n; i++ ) { mpz_init(r[i]); mpz_set_ui(r[i],0); }
6016: for ( i = 0, s = s0, m = BDY(d); m; m = NEXT(m) ) {
6017: t = DL(m);
6018: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
6019: mpz_set(r[i],BDY(CZ(m)));
6020: }
6021: for ( i = 0; !mpz_sgn(r[i]); i++ );
6022: return i;
6023: }
6024:
6025: unsigned long *nd_to_vect_2(UINT *s0,int n,int *s0hash,ND p)
6026: {
6027: NM m;
6028: unsigned long *v;
6029: int i,j,h,size;
6030: UINT *s,*t;
6031:
6032: size = sizeof(unsigned long)*(n+BLEN-1)/BLEN;
6033: v = (unsigned long *)MALLOC_ATOMIC_IGNORE_OFF_PAGE(size);
6034: bzero(v,size);
6035: for ( i = j = 0, s = s0, m = BDY(p); m; j++, m = NEXT(m) ) {
6036: t = DL(m);
6037: h = ndl_hash_value(t);
6038: for ( ; h != s0hash[i] || !ndl_equal(t,s); s += nd_wpd, i++ );
6039: v[i/BLEN] |= 1L <<(i%BLEN);
6040: }
6041: return v;
6042: }
6043:
6044: int nd_nm_to_vect_2(UINT *s0,int n,int *s0hash,NDV p,NM m,unsigned long *v)
6045: {
6046: NMV mr;
6047: UINT *d,*t,*s;
6048: int i,j,len,h,head;
6049:
6050: d = DL(m);
6051: len = LEN(p);
6052: t = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
6053: for ( i = j = 0, s = s0, mr = BDY(p); j < len; j++, NMV_ADV(mr) ) {
6054: ndl_add(d,DL(mr),t);
6055: h = ndl_hash_value(t);
6056: for ( ; h != s0hash[i] || !ndl_equal(t,s); s += nd_wpd, i++ );
6057: if ( j == 0 ) head = i;
6058: v[i/BLEN] |= 1L <<(i%BLEN);
6059: }
6060: return head;
6061: }
6062:
6063: Z *nm_ind_pair_to_vect(int mod,UINT *s0,int n,NM_ind_pair pair)
6064: {
6065: NM m;
6066: NMV mr;
6067: UINT *d,*t,*s;
6068: NDV p;
6069: int i,j,len;
6070: Z *r;
6071:
6072: m = pair->mul;
6073: d = DL(m);
6074: p = nd_ps[pair->index];
6075: len = LEN(p);
6076: r = (Z *)CALLOC(n,sizeof(Q));
6077: t = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
6078: for ( i = j = 0, s = s0, mr = BDY(p); j < len; j++, NMV_ADV(mr) ) {
6079: ndl_add(d,DL(mr),t);
6080: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
1.6 noro 6081: r[i] = CZ(mr);
1.1 noro 6082: }
6083: return r;
6084: }
6085:
1.11 noro 6086: IndArray nm_ind_pair_to_vect_compress(int trace,UINT *s0,int n,NM_ind_pair pair,int start)
1.1 noro 6087: {
6088: NM m;
6089: NMV mr;
1.11 noro 6090: UINT *d,*t,*s,*u;
1.1 noro 6091: NDV p;
6092: unsigned char *ivc;
6093: unsigned short *ivs;
6094: UINT *v,*ivi,*s0v;
1.11 noro 6095: int i,j,len,prev,diff,cdiff,h,st,ed,md,c;
1.1 noro 6096: IndArray r;
6097:
6098: m = pair->mul;
6099: d = DL(m);
6100: if ( trace )
6101: p = nd_demand?nd_ps_trace_sym[pair->index]:nd_ps_trace[pair->index];
6102: else
6103: p = nd_demand?nd_ps_sym[pair->index]:nd_ps[pair->index];
6104:
6105: len = LEN(p);
6106: t = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
6107: v = (unsigned int *)MALLOC(len*sizeof(unsigned int));
1.11 noro 6108: for ( prev = start, mr = BDY(p), j = 0; j < len; j++, NMV_ADV(mr) ) {
6109: ndl_add(d,DL(mr),t);
6110: st = prev;
6111: ed = n;
6112: while ( ed > st ) {
6113: md = (st+ed)/2;
6114: u = s0+md*nd_wpd;
6115: c = DL_COMPARE(u,t);
6116: if ( c == 0 ) break;
6117: else if ( c > 0 ) st = md;
6118: else ed = md;
6119: }
6120: prev = v[j] = md;
1.1 noro 6121: }
6122: r = (IndArray)MALLOC(sizeof(struct oIndArray));
6123: r->head = v[0];
6124: diff = 0;
6125: for ( i = 1; i < len; i++ ) {
6126: cdiff = v[i]-v[i-1]; diff = MAX(cdiff,diff);
6127: }
6128: if ( diff < 256 ) {
6129: r->width = 1;
6130: ivc = (unsigned char *)MALLOC_ATOMIC(len*sizeof(unsigned char));
6131: r->index.c = ivc;
6132: for ( i = 1, ivc[0] = 0; i < len; i++ ) ivc[i] = v[i]-v[i-1];
6133: } else if ( diff < 65536 ) {
6134: r->width = 2;
6135: ivs = (unsigned short *)MALLOC_ATOMIC(len*sizeof(unsigned short));
6136: r->index.s = ivs;
6137: for ( i = 1, ivs[0] = 0; i < len; i++ ) ivs[i] = v[i]-v[i-1];
6138: } else {
6139: r->width = 4;
6140: ivi = (unsigned int *)MALLOC_ATOMIC(len*sizeof(unsigned int));
6141: r->index.i = ivi;
6142: for ( i = 1, ivi[0] = 0; i < len; i++ ) ivi[i] = v[i]-v[i-1];
6143: }
6144: return r;
6145: }
6146:
6147: int compress_array(Z *svect,Z *cvect,int n)
6148: {
6149: int i,j;
6150:
6151: for ( i = j = 0; i < n; i++ )
6152: if ( svect[i] ) cvect[j++] = svect[i];
6153: return j;
6154: }
6155:
6156: void expand_array(Z *svect,Z *cvect,int n)
6157: {
6158: int i,j;
6159:
6160: for ( i = j = 0; j < n; i++ )
6161: if ( svect[i] ) svect[i] = cvect[j++];
6162: }
6163:
1.8 noro 6164: #if 0
1.1 noro 6165: int ndv_reduce_vect_q(Z *svect,int trace,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
6166: {
6167: int i,j,k,len,pos,prev,nz;
6168: Z cs,mcs,c1,c2,cr,gcd,t;
6169: IndArray ivect;
6170: unsigned char *ivc;
6171: unsigned short *ivs;
6172: unsigned int *ivi;
6173: NDV redv;
6174: NMV mr;
6175: NODE rp;
6176: int maxrs;
6177: double hmag;
6178: Z *cvect;
1.3 noro 6179: int l;
1.1 noro 6180:
6181: maxrs = 0;
6182: for ( i = 0; i < col && !svect[i]; i++ );
6183: if ( i == col ) return maxrs;
6184: hmag = p_mag((P)svect[i])*nd_scale;
6185: cvect = (Z *)MALLOC(col*sizeof(Q));
6186: for ( i = 0; i < nred; i++ ) {
6187: ivect = imat[i];
6188: k = ivect->head;
6189: if ( svect[k] ) {
6190: maxrs = MAX(maxrs,rp0[i]->sugar);
6191: redv = nd_demand?ndv_load(rp0[i]->index)
6192: :(trace?nd_ps_trace[rp0[i]->index]:nd_ps[rp0[i]->index]);
6193: len = LEN(redv); mr = BDY(redv);
1.6 noro 6194: igcd_cofactor(svect[k],CZ(mr),&gcd,&cs,&cr);
1.1 noro 6195: chsgnz(cs,&mcs);
6196: if ( !UNIQ(cr) ) {
6197: for ( j = 0; j < col; j++ ) {
6198: mulz(svect[j],cr,&c1); svect[j] = c1;
6199: }
6200: }
6201: svect[k] = 0; prev = k;
6202: switch ( ivect->width ) {
6203: case 1:
6204: ivc = ivect->index.c;
6205: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6206: pos = prev+ivc[j]; prev = pos;
1.6 noro 6207: muladdtoz(CZ(mr),mcs,&svect[pos]);
1.1 noro 6208: }
6209: break;
6210: case 2:
6211: ivs = ivect->index.s;
6212: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6213: pos = prev+ivs[j]; prev = pos;
1.6 noro 6214: muladdtoz(CZ(mr),mcs,&svect[pos]);
1.1 noro 6215: }
6216: break;
6217: case 4:
6218: ivi = ivect->index.i;
6219: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6220: pos = prev+ivi[j]; prev = pos;
1.6 noro 6221: muladdtoz(CZ(mr),mcs,&svect[pos]);
1.1 noro 6222: }
6223: break;
6224: }
6225: for ( j = k+1; j < col && !svect[j]; j++ );
6226: if ( j == col ) break;
6227: if ( hmag && ((double)p_mag((P)svect[j]) > hmag) ) {
6228: nz = compress_array(svect,cvect,col);
6229: removecont_array((P *)cvect,nz,1);
6230: expand_array(svect,cvect,nz);
6231: hmag = ((double)p_mag((P)svect[j]))*nd_scale;
6232: }
6233: }
6234: }
6235: nz = compress_array(svect,cvect,col);
6236: removecont_array((P *)cvect,nz,1);
6237: expand_array(svect,cvect,nz);
6238: if ( DP_Print ) {
6239: fprintf(asir_out,"-"); fflush(asir_out);
6240: }
6241: return maxrs;
6242: }
1.4 noro 6243: #else
1.9 noro 6244:
1.4 noro 6245: /* direct mpz version */
6246: int ndv_reduce_vect_q(Z *svect0,int trace,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
6247: {
6248: int i,j,k,len,pos,prev;
6249: mpz_t cs,cr,gcd;
6250: IndArray ivect;
6251: unsigned char *ivc;
6252: unsigned short *ivs;
6253: unsigned int *ivi;
6254: NDV redv;
6255: NMV mr;
6256: NODE rp;
6257: int maxrs;
6258: double hmag;
6259: int l;
1.13 noro 6260: static mpz_t *svect;
6261: static int svect_len=0;
1.4 noro 6262:
6263: maxrs = 0;
6264: for ( i = 0; i < col && !svect0[i]; i++ );
6265: if ( i == col ) return maxrs;
6266: hmag = p_mag((P)svect0[i])*nd_scale;
1.13 noro 6267: if ( col > svect_len ) {
6268: svect = (mpz_t *)MALLOC(col*sizeof(mpz_t));
6269: svect_len = col;
6270: }
1.4 noro 6271: for ( i = 0; i < col; i++ ) {
6272: mpz_init(svect[i]);
6273: if ( svect0[i] )
6274: mpz_set(svect[i],BDY(svect0[i]));
6275: else
6276: mpz_set_ui(svect[i],0);
6277: }
6278: mpz_init(gcd); mpz_init(cs); mpz_init(cr);
6279: for ( i = 0; i < nred; i++ ) {
6280: ivect = imat[i];
6281: k = ivect->head;
6282: if ( mpz_sgn(svect[k]) ) {
6283: maxrs = MAX(maxrs,rp0[i]->sugar);
6284: redv = nd_demand?ndv_load(rp0[i]->index)
6285: :(trace?nd_ps_trace[rp0[i]->index]:nd_ps[rp0[i]->index]);
6286: len = LEN(redv); mr = BDY(redv);
1.6 noro 6287: mpz_gcd(gcd,svect[k],BDY(CZ(mr)));
1.4 noro 6288: mpz_div(cs,svect[k],gcd);
1.6 noro 6289: mpz_div(cr,BDY(CZ(mr)),gcd);
1.4 noro 6290: mpz_neg(cs,cs);
1.9 noro 6291: if ( MUNIMPZ(cr) )
6292: for ( j = 0; j < col; j++ ) mpz_neg(svect[j],svect[j]);
6293: else if ( !UNIMPZ(cr) )
6294: for ( j = 0; j < col; j++ ) {
6295: if ( mpz_sgn(svect[j]) ) mpz_mul(svect[j],svect[j],cr);
6296: }
1.4 noro 6297: mpz_set_ui(svect[k],0);
6298: prev = k;
6299: switch ( ivect->width ) {
6300: case 1:
6301: ivc = ivect->index.c;
6302: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6303: pos = prev+ivc[j]; prev = pos;
1.6 noro 6304: mpz_addmul(svect[pos],BDY(CZ(mr)),cs);
1.4 noro 6305: }
6306: break;
6307: case 2:
6308: ivs = ivect->index.s;
6309: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6310: pos = prev+ivs[j]; prev = pos;
1.6 noro 6311: mpz_addmul(svect[pos],BDY(CZ(mr)),cs);
1.4 noro 6312: }
6313: break;
6314: case 4:
6315: ivi = ivect->index.i;
6316: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6317: pos = prev+ivi[j]; prev = pos;
1.6 noro 6318: mpz_addmul(svect[pos],BDY(CZ(mr)),cs);
1.4 noro 6319: }
6320: break;
6321: }
6322: for ( j = k+1; j < col && !svect[j]; j++ );
6323: if ( j == col ) break;
6324: if ( hmag && ((double)mpz_sizeinbase(svect[j],2) > hmag) ) {
6325: mpz_removecont_array(svect,col);
6326: hmag = ((double)mpz_sizeinbase(svect[j],2))*nd_scale;
6327: }
6328: }
6329: }
6330: mpz_removecont_array(svect,col);
6331: if ( DP_Print ) {
6332: fprintf(asir_out,"-"); fflush(asir_out);
6333: }
6334: for ( i = 0; i < col; i++ )
6335: if ( mpz_sgn(svect[i]) ) MPZTOZ(svect[i],svect0[i]);
6336: else svect0[i] = 0;
6337: return maxrs;
6338: }
6339: #endif
1.1 noro 6340:
6341: int ndv_reduce_vect(int m,UINT *svect,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
6342: {
6343: int i,j,k,len,pos,prev;
6344: UINT c,c1,c2,c3,up,lo,dmy;
6345: IndArray ivect;
6346: unsigned char *ivc;
6347: unsigned short *ivs;
6348: unsigned int *ivi;
6349: NDV redv;
6350: NMV mr;
6351: NODE rp;
6352: int maxrs;
6353:
6354: maxrs = 0;
6355: for ( i = 0; i < nred; i++ ) {
6356: ivect = imat[i];
6357: k = ivect->head; svect[k] %= m;
6358: if ( (c = svect[k]) != 0 ) {
6359: maxrs = MAX(maxrs,rp0[i]->sugar);
6360: c = m-c; redv = nd_ps[rp0[i]->index];
6361: len = LEN(redv); mr = BDY(redv);
6362: svect[k] = 0; prev = k;
6363: switch ( ivect->width ) {
6364: case 1:
6365: ivc = ivect->index.c;
6366: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6367: pos = prev+ivc[j]; c1 = CM(mr); prev = pos;
6368: if ( c1 ) {
6369: c2 = svect[pos];
6370: DMA(c1,c,c2,up,lo);
6371: if ( up ) { DSAB(m,up,lo,dmy,c3); svect[pos] = c3;
6372: } else svect[pos] = lo;
6373: }
6374: }
6375: break;
6376: case 2:
6377: ivs = ivect->index.s;
6378: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6379: pos = prev+ivs[j]; c1 = CM(mr);
6380: prev = pos;
6381: if ( c1 ) {
6382: c2 = svect[pos];
6383: DMA(c1,c,c2,up,lo);
6384: if ( up ) { DSAB(m,up,lo,dmy,c3); svect[pos] = c3;
6385: } else svect[pos] = lo;
6386: }
6387: }
6388: break;
6389: case 4:
6390: ivi = ivect->index.i;
6391: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6392: pos = prev+ivi[j]; c1 = CM(mr);
6393: prev = pos;
6394: if ( c1 ) {
6395: c2 = svect[pos];
6396: DMA(c1,c,c2,up,lo);
6397: if ( up ) { DSAB(m,up,lo,dmy,c3); svect[pos] = c3;
6398: } else svect[pos] = lo;
6399: }
6400: }
6401: break;
6402: }
6403: }
6404: }
6405: for ( i = 0; i < col; i++ )
6406: if ( svect[i] >= (UINT)m ) svect[i] %= m;
6407: return maxrs;
6408: }
6409:
6410: int ndv_reduce_vect_sf(int m,UINT *svect,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
6411: {
6412: int i,j,k,len,pos,prev;
6413: UINT c,c1,c2,c3,up,lo,dmy;
6414: IndArray ivect;
6415: unsigned char *ivc;
6416: unsigned short *ivs;
6417: unsigned int *ivi;
6418: NDV redv;
6419: NMV mr;
6420: NODE rp;
6421: int maxrs;
6422:
6423: maxrs = 0;
6424: for ( i = 0; i < nred; i++ ) {
6425: ivect = imat[i];
6426: k = ivect->head;
6427: if ( (c = svect[k]) != 0 ) {
6428: maxrs = MAX(maxrs,rp0[i]->sugar);
6429: c = _chsgnsf(c); redv = nd_ps[rp0[i]->index];
6430: len = LEN(redv); mr = BDY(redv);
6431: svect[k] = 0; prev = k;
6432: switch ( ivect->width ) {
6433: case 1:
6434: ivc = ivect->index.c;
6435: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6436: pos = prev+ivc[j]; prev = pos;
6437: svect[pos] = _addsf(_mulsf(CM(mr),c),svect[pos]);
6438: }
6439: break;
6440: case 2:
6441: ivs = ivect->index.s;
6442: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6443: pos = prev+ivs[j]; prev = pos;
6444: svect[pos] = _addsf(_mulsf(CM(mr),c),svect[pos]);
6445: }
6446: break;
6447: case 4:
6448: ivi = ivect->index.i;
6449: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6450: pos = prev+ivi[j]; prev = pos;
6451: svect[pos] = _addsf(_mulsf(CM(mr),c),svect[pos]);
6452: }
6453: break;
6454: }
6455: }
6456: }
6457: return maxrs;
6458: }
6459:
6460: ND nd_add_lf(ND p1,ND p2)
6461: {
6462: int n,c,can;
6463: ND r;
6464: NM m1,m2,mr0,mr,s;
6465: Z t;
6466:
6467: if ( !p1 ) return p2;
6468: else if ( !p2 ) return p1;
6469: else {
6470: can = 0;
6471: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
6472: c = DL_COMPARE(DL(m1),DL(m2));
6473: switch ( c ) {
6474: case 0:
6475: addlf(CZ(m1),CZ(m2),&t);
6476: s = m1; m1 = NEXT(m1);
6477: if ( t ) {
6478: can++; NEXTNM2(mr0,mr,s); CZ(mr) = (t);
6479: } else {
6480: can += 2; FREENM(s);
6481: }
6482: s = m2; m2 = NEXT(m2); FREENM(s);
6483: break;
6484: case 1:
6485: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
6486: break;
6487: case -1:
6488: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
6489: break;
6490: }
6491: }
6492: if ( !mr0 )
6493: if ( m1 ) mr0 = m1;
6494: else if ( m2 ) mr0 = m2;
6495: else return 0;
6496: else if ( m1 ) NEXT(mr) = m1;
6497: else if ( m2 ) NEXT(mr) = m2;
6498: else NEXT(mr) = 0;
6499: BDY(p1) = mr0;
6500: SG(p1) = MAX(SG(p1),SG(p2));
6501: LEN(p1) = LEN(p1)+LEN(p2)-can;
6502: FREEND(p2);
6503: return p1;
6504: }
6505: }
6506:
6507: int ndv_reduce_vect_lf(mpz_t *svect,int trace,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
6508: {
6509: int i,j,k,len,pos,prev;
6510: mpz_t c,mc,c1;
6511: IndArray ivect;
6512: unsigned char *ivc;
6513: unsigned short *ivs;
6514: unsigned int *ivi;
6515: NDV redv;
6516: NMV mr;
6517: NODE rp;
6518: int maxrs;
6519:
6520: maxrs = 0;
6521: lf_lazy = 1;
6522: for ( i = 0; i < nred; i++ ) {
6523: ivect = imat[i];
6524: k = ivect->head;
6525: mpz_mod(svect[k],svect[k],BDY(current_mod_lf));
6526: if ( mpz_sgn(svect[k]) ) {
6527: maxrs = MAX(maxrs,rp0[i]->sugar);
6528: mpz_neg(svect[k],svect[k]);
6529: redv = trace?nd_ps_trace[rp0[i]->index]:nd_ps[rp0[i]->index];
6530: len = LEN(redv); mr = BDY(redv);
6531: prev = k;
6532: switch ( ivect->width ) {
6533: case 1:
6534: ivc = ivect->index.c;
6535: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6536: pos = prev+ivc[j]; prev = pos;
6537: mpz_addmul(svect[pos],svect[k],BDY(CZ(mr)));
6538: }
6539: break;
6540: case 2:
6541: ivs = ivect->index.s;
6542: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6543: pos = prev+ivs[j]; prev = pos;
6544: mpz_addmul(svect[pos],svect[k],BDY(CZ(mr)));
6545: }
6546: break;
6547: case 4:
6548: ivi = ivect->index.i;
6549: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
6550: pos = prev+ivi[j]; prev = pos;
6551: mpz_addmul(svect[pos],svect[k],BDY(CZ(mr)));
6552: }
6553: break;
6554: }
6555: mpz_set_ui(svect[k],0);
6556: }
6557: }
6558: lf_lazy=0;
6559: for ( i = 0; i < col; i++ ) {
6560: mpz_mod(svect[i],svect[i],BDY(current_mod_lf));
6561: }
6562: return maxrs;
6563: }
6564:
6565: int nd_gauss_elim_lf(mpz_t **mat0,int *sugar,int row,int col,int *colstat)
6566: {
6567: int i,j,k,l,rank,s;
6568: mpz_t a,a1,inv;
6569: mpz_t *t,*pivot,*pk;
6570: mpz_t **mat;
6571: struct oEGT eg0,eg1,eg_forward,eg_mod,eg_back;
6572: int size,size1;
6573:
6574: mpz_init(inv);
6575: mpz_init(a);
6576: mat = (mpz_t **)mat0;
6577: size = 0;
6578: for ( rank = 0, j = 0; j < col; j++ ) {
6579: for ( i = rank; i < row; i++ ) {
6580: mpz_mod(mat[i][j],mat[i][j],BDY(current_mod_lf));
6581: }
6582: for ( i = rank; i < row; i++ )
6583: if ( mpz_sgn(mat[i][j]) )
6584: break;
6585: if ( i == row ) {
6586: colstat[j] = 0;
6587: continue;
6588: } else
6589: colstat[j] = 1;
6590: if ( i != rank ) {
6591: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
6592: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
6593: }
6594: pivot = mat[rank];
6595: s = sugar[rank];
6596: mpz_invert(inv,pivot[j],BDY(current_mod_lf));
6597: for ( k = j, pk = pivot+k; k < col; k++, pk++ )
6598: if ( mpz_sgn(*pk) ) {
6599: mpz_mul(a,*pk,inv); mpz_mod(*pk,a,BDY(current_mod_lf));
6600: }
6601: for ( i = rank+1; i < row; i++ ) {
6602: t = mat[i];
6603: if ( mpz_sgn(t[j]) ) {
6604: sugar[i] = MAX(sugar[i],s);
6605: mpz_neg(a,t[j]);
6606: red_by_vect_lf(t+j,pivot+j,a,col-j);
6607: }
6608: }
6609: rank++;
6610: }
6611: for ( j = col-1, l = rank-1; j >= 0; j-- )
6612: if ( colstat[j] ) {
6613: pivot = mat[l];
6614: s = sugar[l];
6615: for ( k = j; k < col; k++ )
6616: mpz_mod(pivot[k],pivot[k],BDY(current_mod_lf));
6617: for ( i = 0; i < l; i++ ) {
6618: t = mat[i];
6619: if ( mpz_sgn(t[j]) ) {
6620: sugar[i] = MAX(sugar[i],s);
6621: mpz_neg(a,t[j]);
6622: red_by_vect_lf(t+j,pivot+j,a,col-j);
6623: }
6624: }
6625: l--;
6626: }
6627: for ( j = 0, l = 0; l < rank; j++ )
6628: if ( colstat[j] ) {
6629: t = mat[l];
6630: for ( k = j; k < col; k++ ) {
6631: mpz_mod(t[k],t[k],BDY(current_mod_lf));
6632: }
6633: l++;
6634: }
6635: return rank;
6636: }
6637:
6638:
6639: NDV vect_to_ndv(UINT *vect,int spcol,int col,int *rhead,UINT *s0vect)
6640: {
6641: int j,k,len;
6642: UINT *p;
6643: UINT c;
6644: NDV r;
6645: NMV mr0,mr;
6646:
6647: for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++;
6648: if ( !len ) return 0;
6649: else {
6650: mr0 = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
6651: #if 0
6652: ndv_alloc += nmv_adv*len;
6653: #endif
6654: mr = mr0;
6655: p = s0vect;
6656: for ( j = k = 0; j < col; j++, p += nd_wpd )
6657: if ( !rhead[j] ) {
6658: if ( (c = vect[k++]) != 0 ) {
6659: ndl_copy(p,DL(mr)); CM(mr) = c; NMV_ADV(mr);
6660: }
6661: }
6662: MKNDV(nd_nvar,mr0,len,r);
6663: return r;
6664: }
6665: }
6666:
6667: NDV vect_to_ndv_2(unsigned long *vect,int col,UINT *s0vect)
6668: {
6669: int j,k,len;
6670: UINT *p;
6671: NDV r;
6672: NMV mr0,mr;
6673:
6674: for ( j = 0, len = 0; j < col; j++ ) if ( vect[j/BLEN] & (1L<<(j%BLEN)) ) len++;
6675: if ( !len ) return 0;
6676: else {
6677: mr0 = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
6678: mr = mr0;
6679: p = s0vect;
6680: for ( j = 0; j < col; j++, p += nd_wpd )
6681: if ( vect[j/BLEN] & (1L<<(j%BLEN)) ) {
6682: ndl_copy(p,DL(mr)); CM(mr) = 1; NMV_ADV(mr);
6683: }
6684: MKNDV(nd_nvar,mr0,len,r);
6685: return r;
6686: }
6687: }
6688:
6689: /* for preprocessed vector */
6690:
6691: NDV vect_to_ndv_q(Z *vect,int spcol,int col,int *rhead,UINT *s0vect)
6692: {
1.6 noro 6693: int j,k,len;
6694: UINT *p;
6695: Z c;
6696: NDV r;
6697: NMV mr0,mr;
1.1 noro 6698:
1.6 noro 6699: for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++;
6700: if ( !len ) return 0;
6701: else {
6702: mr0 = (NMV)MALLOC(nmv_adv*len);
1.1 noro 6703: #if 0
1.6 noro 6704: ndv_alloc += nmv_adv*len;
1.1 noro 6705: #endif
1.6 noro 6706: mr = mr0;
6707: p = s0vect;
6708: for ( j = k = 0; j < col; j++, p += nd_wpd ) {
6709: if ( !rhead[j] ) {
6710: if ( (c = vect[k++]) != 0 ) {
6711: if ( !INT(c) )
6712: error("vect_to_ndv_q : components must be integers");
6713: ndl_copy(p,DL(mr)); CZ(mr) = c; NMV_ADV(mr);
6714: }
6715: }
1.1 noro 6716: }
1.6 noro 6717: MKNDV(nd_nvar,mr0,len,r);
6718: return r;
6719: }
1.1 noro 6720: }
6721:
6722: NDV vect_to_ndv_lf(mpz_t *vect,int spcol,int col,int *rhead,UINT *s0vect)
6723: {
6724: int j,k,len;
6725: UINT *p;
6726: mpz_t c;
6727: NDV r;
6728: NMV mr0,mr;
6729:
6730: for ( j = 0, len = 0; j < spcol; j++ ) if ( mpz_sgn(vect[j]) ) len++;
6731: if ( !len ) return 0;
6732: else {
6733: mr0 = (NMV)MALLOC(nmv_adv*len);
6734: #if 0
6735: ndv_alloc += nmv_adv*len;
6736: #endif
6737: mr = mr0;
6738: p = s0vect;
6739: for ( j = k = 0; j < col; j++, p += nd_wpd )
6740: if ( !rhead[j] ) {
6741: c[0] = vect[k++][0];
6742: if ( mpz_sgn(c) ) {
6743: ndl_copy(p,DL(mr)); MPZTOZ(c,CZ(mr)); NMV_ADV(mr);
6744: }
6745: }
6746: MKNDV(nd_nvar,mr0,len,r);
6747: return r;
6748: }
6749: }
6750:
6751: /* for plain vector */
6752:
6753: NDV plain_vect_to_ndv_q(Z *vect,int col,UINT *s0vect)
6754: {
6755: int j,k,len;
6756: UINT *p;
6757: Z c;
6758: NDV r;
6759: NMV mr0,mr;
6760:
6761: for ( j = 0, len = 0; j < col; j++ ) if ( vect[j] ) len++;
6762: if ( !len ) return 0;
6763: else {
6764: mr0 = (NMV)MALLOC(nmv_adv*len);
6765: #if 0
6766: ndv_alloc += nmv_adv*len;
6767: #endif
6768: mr = mr0;
6769: p = s0vect;
6770: for ( j = k = 0; j < col; j++, p += nd_wpd, k++ )
6771: if ( (c = vect[k]) != 0 ) {
6772: if ( !INT(c) )
1.6 noro 6773: error("plain_vect_to_ndv_q : components must be integers");
6774: ndl_copy(p,DL(mr)); CZ(mr) = c; NMV_ADV(mr);
1.1 noro 6775: }
6776: MKNDV(nd_nvar,mr0,len,r);
6777: return r;
6778: }
6779: }
6780:
6781: int nd_sp_f4(int m,int trace,ND_pairs l,PGeoBucket bucket)
6782: {
6783: ND_pairs t;
6784: NODE sp0,sp;
6785: int stat;
6786: ND spol;
6787:
6788: for ( t = l; t; t = NEXT(t) ) {
6789: stat = nd_sp(m,trace,t,&spol);
6790: if ( !stat ) return 0;
6791: if ( spol ) {
6792: add_pbucket_symbolic(bucket,spol);
6793: }
6794: }
6795: return 1;
6796: }
6797:
6798: int nd_symbolic_preproc(PGeoBucket bucket,int trace,UINT **s0vect,NODE *r)
6799: {
6800: NODE rp0,rp;
6801: NM mul,head,s0,s;
6802: int index,col,i,sugar;
6803: RHist h;
6804: UINT *s0v,*p;
6805: NM_ind_pair pair;
6806: ND red;
6807: NDV *ps;
6808:
6809: s0 = 0; rp0 = 0; col = 0;
6810: if ( nd_demand )
6811: ps = trace?nd_ps_trace_sym:nd_ps_sym;
6812: else
6813: ps = trace?nd_ps_trace:nd_ps;
6814: while ( 1 ) {
6815: head = remove_head_pbucket_symbolic(bucket);
6816: if ( !head ) break;
6817: if ( !s0 ) s0 = head;
6818: else NEXT(s) = head;
6819: s = head;
6820: index = ndl_find_reducer(DL(head));
6821: if ( index >= 0 ) {
6822: h = nd_psh[index];
6823: NEWNM(mul);
6824: ndl_sub(DL(head),DL(h),DL(mul));
6825: if ( ndl_check_bound2(index,DL(mul)) )
6826: return 0;
6827: sugar = TD(DL(mul))+SG(ps[index]);
6828: MKNM_ind_pair(pair,mul,index,sugar);
6829: red = ndv_mul_nm_symbolic(mul,ps[index]);
6830: add_pbucket_symbolic(bucket,nd_remove_head(red));
6831: NEXTNODE(rp0,rp); BDY(rp) = (pointer)pair;
6832: }
6833: col++;
6834: }
6835: if ( rp0 ) NEXT(rp) = 0;
6836: NEXT(s) = 0;
6837: s0v = (UINT *)MALLOC_ATOMIC(col*nd_wpd*sizeof(UINT));
6838: for ( i = 0, p = s0v, s = s0; i < col;
6839: i++, p += nd_wpd, s = NEXT(s) ) ndl_copy(DL(s),p);
6840: *s0vect = s0v;
6841: *r = rp0;
6842: return col;
6843: }
6844:
6845: void print_ndp(ND_pairs l)
6846: {
6847: ND_pairs t;
6848:
6849: for ( t = l; t; t = NEXT(t) )
6850: printf("[%d,%d] ",t->i1,t->i2);
6851: printf("\n");
6852: }
6853:
6854: NODE nd_f4(int m,int checkonly,int **indp)
6855: {
6856: int i,nh,stat,index,f4red;
6857: NODE r,g,tn0,tn,node;
6858: ND_pairs d,l,t,ll0,ll,lh;
6859: LIST l0,l1;
6860: ND spol,red;
6861: NDV nf,redv;
6862: NM s0,s;
6863: NODE rp0,srp0,nflist,nzlist,nzlist_t;
6864: int nsp,nred,col,rank,len,k,j,a,i1s,i2s;
6865: UINT c;
6866: UINT **spmat;
6867: UINT *s0vect,*svect,*p,*v;
6868: int *colstat;
6869: IndArray *imat;
6870: int *rhead;
6871: int spcol,sprow;
6872: int sugar,sugarh;
6873: PGeoBucket bucket;
6874: struct oEGT eg0,eg1,eg_f4;
6875: Z i1,i2,sugarq;
1.12 noro 6876:
6877: init_eg(&f4_symb); init_eg(&f4_conv); init_eg(&f4_conv); init_eg(&f4_elim1); init_eg(&f4_elim2);
1.1 noro 6878: #if 0
6879: ndv_alloc = 0;
6880: #endif
1.11 noro 6881: Nf4_red=0;
1.1 noro 6882: g = 0; d = 0;
6883: for ( i = 0; i < nd_psn; i++ ) {
6884: d = update_pairs(d,g,i,0);
6885: g = update_base(g,i);
6886: }
6887: nzlist = 0;
6888: nzlist_t = nd_nzlist;
6889: f4red = 1;
6890: nd_last_nonzero = 0;
6891: while ( d ) {
6892: get_eg(&eg0);
6893: l = nd_minsugarp(d,&d);
6894: sugar = nd_sugarweight?l->sugar2:SG(l);
6895: if ( MaxDeg > 0 && sugar > MaxDeg ) break;
6896: if ( nzlist_t ) {
6897: node = BDY((LIST)BDY(nzlist_t));
1.6 noro 6898: sugarh = ZTOS((Q)ARG0(node));
1.1 noro 6899: tn = BDY((LIST)ARG1(node));
6900: if ( !tn ) {
6901: nzlist_t = NEXT(nzlist_t);
6902: continue;
6903: }
6904: /* tn = [[i1,i2],...] */
6905: lh = nd_ipairtospair(tn);
6906: }
6907: bucket = create_pbucket();
6908: stat = nd_sp_f4(m,0,l,bucket);
6909: if ( !stat ) {
6910: for ( t = l; NEXT(t); t = NEXT(t) );
6911: NEXT(t) = d; d = l;
6912: d = nd_reconstruct(0,d);
6913: continue;
6914: }
6915: if ( bucket->m < 0 ) continue;
6916: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
6917: if ( !col ) {
6918: for ( t = l; NEXT(t); t = NEXT(t) );
6919: NEXT(t) = d; d = l;
6920: d = nd_reconstruct(0,d);
6921: continue;
6922: }
1.12 noro 6923: get_eg(&eg1); init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg1); add_eg(&f4_symb,&eg0,&eg1);
1.1 noro 6924: if ( DP_Print )
1.6 noro 6925: fprintf(asir_out,"sugar=%d,symb=%.3fsec,",
1.5 noro 6926: sugar,eg_f4.exectime);
1.1 noro 6927: nflist = nd_f4_red(m,nd_nzlist?lh:l,0,s0vect,col,rp0,nd_gentrace?&ll:0);
6928: if ( checkonly && nflist ) return 0;
6929: /* adding new bases */
6930: if ( nflist ) nd_last_nonzero = f4red;
6931: for ( r = nflist; r; r = NEXT(r) ) {
6932: nf = (NDV)BDY(r);
6933: ndv_removecont(m,nf);
6934: if ( !m && nd_nalg ) {
6935: ND nf1;
6936:
6937: nf1 = ndvtond(m,nf);
6938: nd_monic(0,&nf1);
6939: nd_removecont(m,nf1);
6940: nf = ndtondv(m,nf1);
6941: }
6942: nh = ndv_newps(m,nf,0,1);
6943: d = update_pairs(d,g,nh,0);
6944: g = update_base(g,nh);
6945: }
6946: if ( DP_Print ) {
6947: fprintf(asir_out,"f4red=%d,gblen=%d\n",f4red,length(g)); fflush(asir_out);
6948: }
6949: if ( nd_gentrace ) {
6950: for ( t = ll, tn0 = 0; t; t = NEXT(t) ) {
6951: NEXTNODE(tn0,tn);
1.6 noro 6952: STOZ(t->i1,i1); STOZ(t->i2,i2);
1.1 noro 6953: node = mknode(2,i1,i2); MKLIST(l0,node);
6954: BDY(tn) = l0;
6955: }
6956: if ( tn0 ) NEXT(tn) = 0; MKLIST(l0,tn0);
1.6 noro 6957: STOZ(sugar,sugarq); node = mknode(2,sugarq,l0); MKLIST(l1,node);
1.1 noro 6958: MKNODE(node,l1,nzlist); nzlist = node;
6959: }
6960: if ( nd_nzlist ) nzlist_t = NEXT(nzlist_t);
6961: f4red++;
6962: if ( nd_f4red && f4red > nd_f4red ) break;
6963: if ( nd_rank0 && !nflist ) break;
6964: }
6965: if ( nd_gentrace ) {
6966: MKLIST(l0,reverse_node(nzlist));
6967: MKNODE(nd_alltracelist,l0,0);
6968: }
6969: #if 0
6970: fprintf(asir_out,"ndv_alloc=%d\n",ndv_alloc);
6971: #endif
1.12 noro 6972: if ( DP_Print ) {
6973: fprintf(asir_out,"number of red=%d,",Nf4_red);
6974: fprintf(asir_out,"symb=%.3fsec,conv=%.3fsec,elim1=%.3fsec,elim2=%.3fsec\n",
6975: f4_symb.exectime,f4_conv.exectime,f4_elim1.exectime,f4_elim2.exectime);
6976: }
1.1 noro 6977: conv_ilist(nd_demand,0,g,indp);
6978: return g;
6979: }
6980:
6981: NODE nd_f4_trace(int m,int **indp)
6982: {
6983: int i,nh,stat,index;
6984: NODE r,g;
6985: ND_pairs d,l,l0,t;
6986: ND spol,red;
6987: NDV nf,redv,nfqv,nfv;
6988: NM s0,s;
6989: NODE rp0,srp0,nflist;
6990: int nsp,nred,col,rank,len,k,j,a;
6991: UINT c;
6992: UINT **spmat;
6993: UINT *s0vect,*svect,*p,*v;
6994: int *colstat;
6995: IndArray *imat;
6996: int *rhead;
6997: int spcol,sprow;
6998: int sugar;
6999: PGeoBucket bucket;
7000: struct oEGT eg0,eg1,eg_f4;
7001:
7002: g = 0; d = 0;
7003: for ( i = 0; i < nd_psn; i++ ) {
7004: d = update_pairs(d,g,i,0);
7005: g = update_base(g,i);
7006: }
7007: while ( d ) {
7008: get_eg(&eg0);
7009: l = nd_minsugarp(d,&d);
7010: sugar = SG(l);
7011: if ( MaxDeg > 0 && sugar > MaxDeg ) break;
7012: bucket = create_pbucket();
7013: stat = nd_sp_f4(m,0,l,bucket);
7014: if ( !stat ) {
7015: for ( t = l; NEXT(t); t = NEXT(t) );
7016: NEXT(t) = d; d = l;
7017: d = nd_reconstruct(1,d);
7018: continue;
7019: }
7020: if ( bucket->m < 0 ) continue;
7021: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
7022: if ( !col ) {
7023: for ( t = l; NEXT(t); t = NEXT(t) );
7024: NEXT(t) = d; d = l;
7025: d = nd_reconstruct(1,d);
7026: continue;
7027: }
7028: get_eg(&eg1); init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg1);
7029: if ( DP_Print )
1.3 noro 7030: fprintf(asir_out,"\nsugar=%d,symb=%.3fsec,",
1.5 noro 7031: sugar,eg_f4.exectime);
1.1 noro 7032: nflist = nd_f4_red(m,l,0,s0vect,col,rp0,&l0);
7033: if ( !l0 ) continue;
7034: l = l0;
7035:
7036: /* over Q */
7037: bucket = create_pbucket();
7038: stat = nd_sp_f4(0,1,l,bucket);
7039: if ( !stat ) {
7040: for ( t = l; NEXT(t); t = NEXT(t) );
7041: NEXT(t) = d; d = l;
7042: d = nd_reconstruct(1,d);
7043: continue;
7044: }
7045: if ( bucket->m < 0 ) continue;
7046: col = nd_symbolic_preproc(bucket,1,&s0vect,&rp0);
7047: if ( !col ) {
7048: for ( t = l; NEXT(t); t = NEXT(t) );
7049: NEXT(t) = d; d = l;
7050: d = nd_reconstruct(1,d);
7051: continue;
7052: }
7053: nflist = nd_f4_red(0,l,1,s0vect,col,rp0,0);
7054: /* adding new bases */
7055: for ( r = nflist; r; r = NEXT(r) ) {
7056: nfqv = (NDV)BDY(r);
7057: ndv_removecont(0,nfqv);
1.6 noro 7058: if ( !remqi((Q)HCZ(nfqv),m) ) return 0;
1.1 noro 7059: if ( nd_nalg ) {
7060: ND nf1;
7061:
7062: nf1 = ndvtond(m,nfqv);
7063: nd_monic(0,&nf1);
7064: nd_removecont(0,nf1);
7065: nfqv = ndtondv(0,nf1); nd_free(nf1);
7066: }
7067: nfv = ndv_dup(0,nfqv);
7068: ndv_mod(m,nfv);
7069: ndv_removecont(m,nfv);
7070: nh = ndv_newps(0,nfv,nfqv,1);
7071: d = update_pairs(d,g,nh,0);
7072: g = update_base(g,nh);
7073: }
7074: }
7075: #if 0
7076: fprintf(asir_out,"ndv_alloc=%d\n",ndv_alloc);
7077: #endif
7078: conv_ilist(nd_demand,1,g,indp);
7079: return g;
7080: }
7081:
7082: int rref(matrix mat,int *sugar)
7083: {
7084: int row,col,i,j,k,l,s,wcol,wj;
7085: unsigned long bj;
7086: unsigned long **a;
7087: unsigned long *ai,*ak,*as,*t;
7088: int *pivot;
7089:
7090: row = mat->row;
7091: col = mat->col;
7092: a = mat->a;
7093: wcol = (col+BLEN-1)/BLEN;
7094: pivot = (int *)MALLOC_ATOMIC(row*sizeof(int));
7095: i = 0;
7096: for ( j = 0; j < col; j++ ) {
7097: wj = j/BLEN; bj = 1L<<(j%BLEN);
7098: for ( k = i; k < row; k++ )
7099: if ( a[k][wj] & bj ) break;
7100: if ( k == row ) continue;
7101: pivot[i] = j;
7102: if ( k != i ) {
7103: t = a[i]; a[i] = a[k]; a[k] = t;
7104: s = sugar[i]; sugar[i] = sugar[k]; sugar[k] = s;
7105: }
7106: ai = a[i];
7107: for ( k = i+1; k < row; k++ ) {
7108: ak = a[k];
7109: if ( ak[wj] & bj ) {
7110: for ( l = wj; l < wcol; l++ )
7111: ak[l] ^= ai[l];
7112: sugar[k] = MAX(sugar[k],sugar[i]);
7113: }
7114: }
7115: i++;
7116: }
7117: for ( k = i-1; k >= 0; k-- ) {
7118: j = pivot[k]; wj = j/BLEN; bj = 1L<<(j%BLEN);
7119: ak = a[k];
7120: for ( s = 0; s < k; s++ ) {
7121: as = a[s];
7122: if ( as[wj] & bj ) {
7123: for ( l = wj; l < wcol; l++ )
7124: as[l] ^= ak[l];
7125: sugar[s] = MAX(sugar[s],sugar[k]);
7126: }
7127: }
7128: }
7129: return i;
7130: }
7131:
7132: void print_matrix(matrix mat)
7133: {
7134: int row,col,i,j;
7135: unsigned long *ai;
7136:
7137: row = mat->row;
7138: col = mat->col;
7139: printf("%d x %d\n",row,col);
7140: for ( i = 0; i < row; i++ ) {
7141: ai = mat->a[i];
7142: for ( j = 0; j < col; j++ ) {
7143: if ( ai[j/BLEN] & (1L<<(j%BLEN)) ) putchar('1');
7144: else putchar('0');
7145: }
7146: putchar('\n');
7147: }
7148: }
7149:
7150: NDV vect_to_ndv_2(unsigned long *vect,int col,UINT *s0vect);
7151:
7152: void red_by_vect_2(matrix mat,int *sugar,unsigned long *v,int rhead,int rsugar)
7153: {
7154: int row,col,wcol,wj,i,j;
7155: unsigned long bj;
7156: unsigned long *ai;
7157: unsigned long **a;
7158: int len;
7159: int *pos;
7160:
7161: row = mat->row;
7162: col = mat->col;
7163: wcol = (col+BLEN-1)/BLEN;
7164: pos = (int *)MALLOC(wcol*sizeof(int));
7165: bzero(pos,wcol*sizeof(int));
7166: for ( i = j = 0; i < wcol; i++ )
7167: if ( v[i] ) pos[j++] = i;;
7168: len = j;
7169: wj = rhead/BLEN;
7170: bj = 1L<<rhead%BLEN;
7171: a = mat->a;
7172: for ( i = 0; i < row; i++ ) {
7173: ai = a[i];
7174: if ( ai[wj]&bj ) {
7175: for ( j = 0; j < len; j++ )
7176: ai[pos[j]] ^= v[pos[j]];
7177: sugar[i] = MAX(sugar[i],rsugar);
7178: }
7179: }
7180: }
7181:
7182: NODE nd_f4_red_2(ND_pairs sp0,UINT *s0vect,int col,NODE rp0,ND_pairs *nz)
7183: {
7184: int nsp,nred,i,i0,k,rank,row;
7185: NODE r0,rp;
7186: ND_pairs sp;
7187: ND spol;
7188: NM_ind_pair rt;
7189: int *s0hash;
7190: UINT *s;
7191: int *pivot,*sugar,*head;
7192: matrix mat;
7193: NM m;
7194: NODE r;
7195: struct oEGT eg0,eg1,eg2,eg_elim1,eg_elim2;
7196: int rhead,rsugar,size;
7197: unsigned long *v;
7198:
7199: get_eg(&eg0);
7200: for ( sp = sp0, nsp = 0; sp; sp = NEXT(sp), nsp++ );
7201: nred = length(rp0);
7202: mat = alloc_matrix(nsp,col);
7203: s0hash = (int *)MALLOC(col*sizeof(int));
7204: for ( i = 0, s = s0vect; i < col; i++, s += nd_wpd )
7205: s0hash[i] = ndl_hash_value(s);
7206:
7207: sugar = (int *)MALLOC(nsp*sizeof(int));
7208: for ( i = 0, sp = sp0; sp; sp = NEXT(sp) ) {
7209: nd_sp(2,0,sp,&spol);
7210: if ( spol ) {
7211: mat->a[i] = nd_to_vect_2(s0vect,col,s0hash,spol);
7212: sugar[i] = SG(spol);
7213: i++;
7214: }
7215: }
7216: mat->row = i;
7217: if ( DP_Print ) {
7218: fprintf(asir_out,"%dx%d,",mat->row,mat->col); fflush(asir_out);
7219: }
7220: size = ((col+BLEN-1)/BLEN)*sizeof(unsigned long);
7221: v = CALLOC((col+BLEN-1)/BLEN,sizeof(unsigned long));
7222: for ( rp = rp0, i = 0; rp; rp = NEXT(rp), i++ ) {
7223: rt = (NM_ind_pair)BDY(rp);
7224: bzero(v,size);
7225: rhead = nd_nm_to_vect_2(s0vect,col,s0hash,nd_ps[rt->index],rt->mul,v);
7226: rsugar = SG(nd_ps[rt->index])+TD(DL(rt->mul));
7227: red_by_vect_2(mat,sugar,v,rhead,rsugar);
7228: }
7229:
7230: get_eg(&eg1);
7231: init_eg(&eg_elim1); add_eg(&eg_elim1,&eg0,&eg1);
7232: rank = rref(mat,sugar);
7233:
7234: for ( i = 0, r0 = 0; i < rank; i++ ) {
7235: NEXTNODE(r0,r);
7236: BDY(r) = (pointer)vect_to_ndv_2(mat->a[i],col,s0vect);
7237: SG((NDV)BDY(r)) = sugar[i];
7238: }
7239: if ( r0 ) NEXT(r) = 0;
7240: get_eg(&eg2);
7241: init_eg(&eg_elim2); add_eg(&eg_elim2,&eg1,&eg2);
7242: if ( DP_Print ) {
7243: fprintf(asir_out,"elim1=%.3fsec,elim2=%.3fsec,",
1.5 noro 7244: eg_elim1.exectime,eg_elim2.exectime);
1.1 noro 7245: fflush(asir_out);
7246: }
7247: return r0;
7248: }
7249:
7250:
7251: NODE nd_f4_red(int m,ND_pairs sp0,int trace,UINT *s0vect,int col,NODE rp0,ND_pairs *nz)
7252: {
7253: IndArray *imat;
1.11 noro 7254: int nsp,nred,i,start;
1.1 noro 7255: int *rhead;
7256: NODE r0,rp;
7257: ND_pairs sp;
7258: NM_ind_pair *rvect;
7259: UINT *s;
7260: int *s0hash;
1.11 noro 7261: struct oEGT eg0,eg1,eg_conv;
1.1 noro 7262:
7263: if ( m == 2 && nd_rref2 )
7264: return nd_f4_red_2(sp0,s0vect,col,rp0,nz);
7265:
7266: for ( sp = sp0, nsp = 0; sp; sp = NEXT(sp), nsp++ );
7267: nred = length(rp0);
7268: imat = (IndArray *)MALLOC(nred*sizeof(IndArray));
7269: rhead = (int *)MALLOC(col*sizeof(int));
7270: for ( i = 0; i < col; i++ ) rhead[i] = 0;
7271:
7272: /* construction of index arrays */
1.11 noro 7273: get_eg(&eg0);
1.1 noro 7274: if ( DP_Print ) {
1.11 noro 7275: fprintf(asir_out,"%dx%d,",nsp+nred,col);
7276: fflush(asir_out);
1.1 noro 7277: }
7278: rvect = (NM_ind_pair *)MALLOC(nred*sizeof(NM_ind_pair));
1.11 noro 7279: for ( start = 0, rp = rp0, i = 0; rp; i++, rp = NEXT(rp) ) {
1.1 noro 7280: rvect[i] = (NM_ind_pair)BDY(rp);
1.11 noro 7281: imat[i] = nm_ind_pair_to_vect_compress(trace,s0vect,col,rvect[i],start);
1.1 noro 7282: rhead[imat[i]->head] = 1;
1.11 noro 7283: start = imat[i]->head;
7284: }
1.12 noro 7285: get_eg(&eg1); init_eg(&eg_conv); add_eg(&eg_conv,&eg0,&eg1); add_eg(&f4_conv,&eg0,&eg1);
1.11 noro 7286: if ( DP_Print ) {
7287: fprintf(asir_out,"conv=%.3fsec,",eg_conv.exectime);
7288: fflush(asir_out);
1.1 noro 7289: }
7290: if ( m > 0 )
1.7 noro 7291: #if SIZEOF_LONG==8
1.1 noro 7292: r0 = nd_f4_red_mod64_main(m,sp0,nsp,s0vect,col,rvect,rhead,imat,nred,nz);
7293: #else
7294: r0 = nd_f4_red_main(m,sp0,nsp,s0vect,col,rvect,rhead,imat,nred,nz);
7295: #endif
7296: else if ( m == -1 )
7297: r0 = nd_f4_red_sf_main(m,sp0,nsp,s0vect,col,rvect,rhead,imat,nred,nz);
7298: else if ( m == -2 )
7299: r0 = nd_f4_red_lf_main(m,sp0,nsp,trace,s0vect,col,rvect,rhead,imat,nred);
7300: else
7301: r0 = nd_f4_red_q_main(sp0,nsp,trace,s0vect,col,rvect,rhead,imat,nred);
7302: return r0;
7303: }
7304:
7305: /* for Fp, 2<=p<2^16 */
7306:
7307: NODE nd_f4_red_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
7308: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz)
7309: {
7310: int spcol,sprow,a;
7311: int i,j,k,l,rank;
7312: NODE r0,r;
7313: ND_pairs sp;
7314: ND spol;
7315: UINT **spmat;
7316: UINT *svect,*v;
7317: int *colstat;
7318: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
7319: int maxrs;
7320: int *spsugar;
7321: ND_pairs *spactive;
7322:
7323: spcol = col-nred;
7324: get_eg(&eg0);
7325: /* elimination (1st step) */
7326: spmat = (UINT **)MALLOC(nsp*sizeof(UINT *));
7327: svect = (UINT *)MALLOC(col*sizeof(UINT));
7328: spsugar = (int *)MALLOC(nsp*sizeof(int));
7329: spactive = !nz?0:(ND_pairs *)MALLOC(nsp*sizeof(ND_pairs));
7330: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
7331: nd_sp(m,0,sp,&spol);
7332: if ( !spol ) continue;
7333: nd_to_vect(m,s0vect,col,spol,svect);
7334: if ( m == -1 )
7335: maxrs = ndv_reduce_vect_sf(m,svect,col,imat,rvect,nred);
7336: else
7337: maxrs = ndv_reduce_vect(m,svect,col,imat,rvect,nred);
7338: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
7339: if ( i < col ) {
7340: spmat[sprow] = v = (UINT *)MALLOC_ATOMIC(spcol*sizeof(UINT));
7341: for ( j = k = 0; j < col; j++ )
7342: if ( !rhead[j] ) v[k++] = svect[j];
7343: spsugar[sprow] = MAX(maxrs,SG(spol));
7344: if ( nz )
7345: spactive[sprow] = sp;
7346: sprow++;
7347: }
7348: nd_free(spol);
7349: }
7350: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
7351: if ( DP_Print ) {
1.5 noro 7352: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 7353: fflush(asir_out);
7354: }
7355: /* free index arrays */
7356: for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c);
7357:
7358: /* elimination (2nd step) */
7359: colstat = (int *)MALLOC(spcol*sizeof(int));
7360: if ( m == -1 )
7361: rank = nd_gauss_elim_sf(spmat,spsugar,sprow,spcol,m,colstat);
7362: else
7363: rank = nd_gauss_elim_mod(spmat,spsugar,spactive,sprow,spcol,m,colstat);
7364: r0 = 0;
7365: for ( i = 0; i < rank; i++ ) {
7366: NEXTNODE(r0,r); BDY(r) =
7367: (pointer)vect_to_ndv(spmat[i],spcol,col,rhead,s0vect);
7368: SG((NDV)BDY(r)) = spsugar[i];
7369: GCFREE(spmat[i]);
7370: }
7371: if ( r0 ) NEXT(r) = 0;
7372:
7373: for ( ; i < sprow; i++ ) GCFREE(spmat[i]);
7374: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
7375: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
7376: if ( DP_Print ) {
1.5 noro 7377: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 7378: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
7379: nsp,nred,sprow,spcol,rank);
1.5 noro 7380: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 7381: }
7382: if ( nz ) {
7383: for ( i = 0; i < rank-1; i++ ) NEXT(spactive[i]) = spactive[i+1];
7384: if ( rank > 0 ) {
7385: NEXT(spactive[rank-1]) = 0;
7386: *nz = spactive[0];
7387: } else
7388: *nz = 0;
7389: }
7390: return r0;
7391: }
7392:
7393:
7394: /* for small finite fields */
7395:
7396: NODE nd_f4_red_sf_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
7397: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz)
7398: {
7399: int spcol,sprow,a;
7400: int i,j,k,l,rank;
7401: NODE r0,r;
7402: ND_pairs sp;
7403: ND spol;
7404: UINT **spmat;
7405: UINT *svect,*v;
7406: int *colstat;
7407: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
7408: int maxrs;
7409: int *spsugar;
7410: ND_pairs *spactive;
7411:
7412: spcol = col-nred;
7413: get_eg(&eg0);
7414: /* elimination (1st step) */
7415: spmat = (UINT **)MALLOC(nsp*sizeof(UINT *));
7416: svect = (UINT *)MALLOC(col*sizeof(UINT));
7417: spsugar = (int *)MALLOC(nsp*sizeof(int));
7418: spactive = !nz?0:(ND_pairs *)MALLOC(nsp*sizeof(ND_pairs));
7419: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
7420: nd_sp(m,0,sp,&spol);
7421: if ( !spol ) continue;
7422: nd_to_vect(m,s0vect,col,spol,svect);
7423: maxrs = ndv_reduce_vect_sf(m,svect,col,imat,rvect,nred);
7424: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
7425: if ( i < col ) {
7426: spmat[sprow] = v = (UINT *)MALLOC_ATOMIC(spcol*sizeof(UINT));
7427: for ( j = k = 0; j < col; j++ )
7428: if ( !rhead[j] ) v[k++] = svect[j];
7429: spsugar[sprow] = MAX(maxrs,SG(spol));
7430: if ( nz )
7431: spactive[sprow] = sp;
7432: sprow++;
7433: }
7434: nd_free(spol);
7435: }
7436: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
7437: if ( DP_Print ) {
1.5 noro 7438: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 7439: fflush(asir_out);
7440: }
7441: /* free index arrays */
7442: for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c);
7443:
7444: /* elimination (2nd step) */
7445: colstat = (int *)MALLOC(spcol*sizeof(int));
7446: rank = nd_gauss_elim_sf(spmat,spsugar,sprow,spcol,m,colstat);
7447: r0 = 0;
7448: for ( i = 0; i < rank; i++ ) {
7449: NEXTNODE(r0,r); BDY(r) =
7450: (pointer)vect_to_ndv(spmat[i],spcol,col,rhead,s0vect);
7451: SG((NDV)BDY(r)) = spsugar[i];
7452: GCFREE(spmat[i]);
7453: }
7454: if ( r0 ) NEXT(r) = 0;
7455:
7456: for ( ; i < sprow; i++ ) GCFREE(spmat[i]);
7457: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
7458: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
7459: if ( DP_Print ) {
1.5 noro 7460: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 7461: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
7462: nsp,nred,sprow,spcol,rank);
1.5 noro 7463: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 7464: }
7465: if ( nz ) {
7466: for ( i = 0; i < rank-1; i++ ) NEXT(spactive[i]) = spactive[i+1];
7467: if ( rank > 0 ) {
7468: NEXT(spactive[rank-1]) = 0;
7469: *nz = spactive[0];
7470: } else
7471: *nz = 0;
7472: }
7473: return r0;
7474: }
7475:
7476: NODE nd_f4_red_lf_main(int m,ND_pairs sp0,int nsp,int trace,UINT *s0vect,int col,
7477: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred)
7478: {
7479: int spcol,sprow,a;
7480: int i,j,k,l,rank;
7481: NODE r0,r;
7482: ND_pairs sp;
7483: ND spol;
7484: mpz_t **spmat;
7485: mpz_t *svect,*v;
7486: int *colstat;
7487: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
7488: int maxrs;
7489: int *spsugar;
7490: pointer *w;
7491:
7492: spcol = col-nred;
7493: get_eg(&eg0);
7494: /* elimination (1st step) */
7495: spmat = (mpz_t **)MALLOC(nsp*sizeof(mpz_t *));
7496: svect = (mpz_t *)MALLOC(col*sizeof(mpz_t));
7497: spsugar = (int *)MALLOC(nsp*sizeof(int));
7498: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
7499: nd_sp(m,trace,sp,&spol);
7500: if ( !spol ) continue;
7501: nd_to_vect_lf(s0vect,col,spol,svect);
7502: maxrs = ndv_reduce_vect_lf(svect,trace,col,imat,rvect,nred);
7503: for ( i = 0; i < col; i++ ) if ( mpz_sgn(svect[i]) ) break;
7504: if ( i < col ) {
7505: spmat[sprow] = v = (mpz_t *)MALLOC(spcol*sizeof(mpz_t));
7506: for ( j = k = 0; j < col; j++ )
7507: if ( !rhead[j] ) v[k++][0] = svect[j][0];
7508: spsugar[sprow] = MAX(maxrs,SG(spol));
7509: sprow++;
7510: }
7511: /* nd_free(spol); */
7512: }
7513: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
7514: if ( DP_Print ) {
1.5 noro 7515: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 7516: fflush(asir_out);
7517: }
7518: /* free index arrays */
7519: /* for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c); */
7520:
7521: /* elimination (2nd step) */
7522: colstat = (int *)MALLOC(spcol*sizeof(int));
7523: rank = nd_gauss_elim_lf(spmat,spsugar,sprow,spcol,colstat);
7524: w = (pointer *)MALLOC(rank*sizeof(pointer));
7525: for ( i = 0; i < rank; i++ ) {
7526: #if 0
7527: w[rank-i-1] = (pointer)vect_to_ndv_lf(spmat[i],spcol,col,rhead,s0vect);
7528: SG((NDV)w[rank-i-1]) = spsugar[i];
7529: #else
7530: w[i] = (pointer)vect_to_ndv_lf(spmat[i],spcol,col,rhead,s0vect);
7531: SG((NDV)w[i]) = spsugar[i];
7532: #endif
7533: /* GCFREE(spmat[i]); */
7534:
7535: }
7536: #if 0
7537: qsort(w,rank,sizeof(NDV),
7538: (int (*)(const void *,const void *))ndv_compare);
7539: #endif
7540: r0 = 0;
7541: for ( i = 0; i < rank; i++ ) {
7542: NEXTNODE(r0,r); BDY(r) = w[i];
7543: }
7544: if ( r0 ) NEXT(r) = 0;
7545:
7546: /* for ( ; i < sprow; i++ ) GCFREE(spmat[i]); */
7547: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
7548: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
7549: if ( DP_Print ) {
1.5 noro 7550: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 7551: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
7552: nsp,nred,sprow,spcol,rank);
1.5 noro 7553: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 7554: }
7555: return r0;
7556: }
7557:
7558: NODE nd_f4_red_q_main(ND_pairs sp0,int nsp,int trace,UINT *s0vect,int col,
7559: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred)
7560: {
7561: int spcol,sprow,a;
7562: int i,j,k,l,rank;
7563: NODE r0,r;
7564: ND_pairs sp;
7565: ND spol;
7566: Z **spmat;
7567: Z *svect,*v;
7568: int *colstat;
7569: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
7570: int maxrs;
7571: int *spsugar;
7572: pointer *w;
7573:
7574: spcol = col-nred;
7575: get_eg(&eg0);
7576: /* elimination (1st step) */
7577: spmat = (Z **)MALLOC(nsp*sizeof(Q *));
7578: svect = (Z *)MALLOC(col*sizeof(Q));
7579: spsugar = (int *)MALLOC(nsp*sizeof(int));
7580: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
7581: nd_sp(0,trace,sp,&spol);
7582: if ( !spol ) continue;
7583: nd_to_vect_q(s0vect,col,spol,svect);
7584: maxrs = ndv_reduce_vect_q(svect,trace,col,imat,rvect,nred);
7585: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
7586: if ( i < col ) {
7587: spmat[sprow] = v = (Z *)MALLOC(spcol*sizeof(Q));
7588: for ( j = k = 0; j < col; j++ )
7589: if ( !rhead[j] ) v[k++] = svect[j];
7590: spsugar[sprow] = MAX(maxrs,SG(spol));
7591: sprow++;
7592: }
7593: /* nd_free(spol); */
7594: }
7595: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
7596: if ( DP_Print ) {
1.5 noro 7597: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 7598: fflush(asir_out);
7599: }
7600: /* free index arrays */
7601: /* for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c); */
7602:
7603: /* elimination (2nd step) */
7604: colstat = (int *)MALLOC(spcol*sizeof(int));
7605: rank = nd_gauss_elim_q(spmat,spsugar,sprow,spcol,colstat);
7606: w = (pointer *)MALLOC(rank*sizeof(pointer));
7607: for ( i = 0; i < rank; i++ ) {
7608: #if 0
7609: w[rank-i-1] = (pointer)vect_to_ndv_q(spmat[i],spcol,col,rhead,s0vect);
7610: SG((NDV)w[rank-i-1]) = spsugar[i];
7611: #else
7612: w[i] = (pointer)vect_to_ndv_q(spmat[i],spcol,col,rhead,s0vect);
7613: SG((NDV)w[i]) = spsugar[i];
7614: #endif
7615: /* GCFREE(spmat[i]); */
7616: }
7617: #if 0
7618: qsort(w,rank,sizeof(NDV),
7619: (int (*)(const void *,const void *))ndv_compare);
7620: #endif
7621: r0 = 0;
7622: for ( i = 0; i < rank; i++ ) {
7623: NEXTNODE(r0,r); BDY(r) = w[i];
7624: }
7625: if ( r0 ) NEXT(r) = 0;
7626:
7627: /* for ( ; i < sprow; i++ ) GCFREE(spmat[i]); */
7628: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
7629: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
7630: if ( DP_Print ) {
1.5 noro 7631: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 7632: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
7633: nsp,nred,sprow,spcol,rank);
1.5 noro 7634: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 7635: }
7636: return r0;
7637: }
7638:
7639: FILE *nd_write,*nd_read;
7640:
7641: void nd_send_int(int a) {
7642: write_int(nd_write,(unsigned int *)&a);
7643: }
7644:
7645: void nd_send_intarray(int *p,int len) {
7646: write_intarray(nd_write,(unsigned int *)p,len);
7647: }
7648:
7649: int nd_recv_int() {
7650: int a;
7651:
7652: read_int(nd_read,(unsigned int *)&a);
7653: return a;
7654: }
7655:
7656: void nd_recv_intarray(int *p,int len) {
7657: read_intarray(nd_read,(unsigned int *)p,len);
7658: }
7659:
7660: void nd_send_ndv(NDV p) {
7661: int len,i;
7662: NMV m;
7663:
7664: if ( !p ) nd_send_int(0);
7665: else {
7666: len = LEN(p);
7667: nd_send_int(len);
7668: m = BDY(p);
7669: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
7670: nd_send_int(CM(m));
7671: nd_send_intarray((int *)DL(m),nd_wpd);
7672: }
7673: }
7674: }
7675:
7676: void nd_send_nd(ND p) {
7677: int len,i;
7678: NM m;
7679:
7680: if ( !p ) nd_send_int(0);
7681: else {
7682: len = LEN(p);
7683: nd_send_int(len);
7684: m = BDY(p);
7685: for ( i = 0; i < len; i++, m = NEXT(m) ) {
7686: nd_send_int(CM(m));
7687: nd_send_intarray((int *)DL(m),nd_wpd);
7688: }
7689: }
7690: }
7691:
7692: NDV nd_recv_ndv()
7693: {
7694: int len,i;
7695: NMV m,m0;
7696: NDV r;
7697:
7698: len = nd_recv_int();
7699: if ( !len ) return 0;
7700: else {
7701: m0 = m = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
7702: #if 0
7703: ndv_alloc += len*nmv_adv;
7704: #endif
7705: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
7706: CM(m) = nd_recv_int();
7707: nd_recv_intarray((int *)DL(m),nd_wpd);
7708: }
7709: MKNDV(nd_nvar,m0,len,r);
7710: return r;
7711: }
7712: }
7713:
7714: int nd_gauss_elim_q(Z **mat0,int *sugar,int row,int col,int *colstat)
7715: {
7716: int i,j,t,c,rank,inv;
7717: int *ci,*ri;
7718: Z dn;
7719: MAT m,nm;
7720:
7721: NEWMAT(m); m->row = row; m->col = col; m->body = (pointer **)mat0;
7722: rank = generic_gauss_elim(m,&nm,&dn,&ri,&ci);
7723: for ( i = 0; i < row; i++ )
7724: for ( j = 0; j < col; j++ )
7725: mat0[i][j] = 0;
7726: c = col-rank;
7727: for ( i = 0; i < rank; i++ ) {
7728: mat0[i][ri[i]] = dn;
7729: for ( j = 0; j < c; j++ )
7730: mat0[i][ci[j]] = (Z)BDY(nm)[i][j];
7731: }
7732: return rank;
7733: }
7734:
7735: int nd_gauss_elim_mod(UINT **mat0,int *sugar,ND_pairs *spactive,int row,int col,int md,int *colstat)
7736: {
7737: int i,j,k,l,inv,a,rank,s;
7738: unsigned int *t,*pivot,*pk;
7739: unsigned int **mat;
7740: ND_pairs pair;
7741:
7742: mat = (unsigned int **)mat0;
7743: for ( rank = 0, j = 0; j < col; j++ ) {
7744: for ( i = rank; i < row; i++ )
7745: mat[i][j] %= md;
7746: for ( i = rank; i < row; i++ )
7747: if ( mat[i][j] )
7748: break;
7749: if ( i == row ) {
7750: colstat[j] = 0;
7751: continue;
7752: } else
7753: colstat[j] = 1;
7754: if ( i != rank ) {
7755: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
7756: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
7757: if ( spactive ) {
7758: pair = spactive[i]; spactive[i] = spactive[rank];
7759: spactive[rank] = pair;
7760: }
7761: }
7762: pivot = mat[rank];
7763: s = sugar[rank];
7764: inv = invm(pivot[j],md);
7765: for ( k = j, pk = pivot+k; k < col; k++, pk++ )
7766: if ( *pk ) {
7767: if ( *pk >= (unsigned int)md )
7768: *pk %= md;
7769: DMAR(*pk,inv,0,md,*pk)
7770: }
7771: for ( i = rank+1; i < row; i++ ) {
7772: t = mat[i];
7773: if ( (a = t[j]) != 0 ) {
7774: sugar[i] = MAX(sugar[i],s);
7775: red_by_vect(md,t+j,pivot+j,md-a,col-j);
7776: }
7777: }
7778: rank++;
7779: }
7780: for ( j = col-1, l = rank-1; j >= 0; j-- )
7781: if ( colstat[j] ) {
7782: pivot = mat[l];
7783: s = sugar[l];
7784: for ( i = 0; i < l; i++ ) {
7785: t = mat[i];
7786: t[j] %= md;
7787: if ( (a = t[j]) != 0 ) {
7788: sugar[i] = MAX(sugar[i],s);
7789: red_by_vect(md,t+j,pivot+j,md-a,col-j);
7790: }
7791: }
7792: l--;
7793: }
7794: for ( j = 0, l = 0; l < rank; j++ )
7795: if ( colstat[j] ) {
7796: t = mat[l];
7797: for ( k = j; k < col; k++ )
7798: if ( t[k] >= (unsigned int)md )
7799: t[k] %= md;
7800: l++;
7801: }
7802: return rank;
7803: }
7804:
7805:
1.7 noro 7806: int nd_gauss_elim_sf(UINT **mat0,int *sugar,int row,int col,int md,int *colstat)
1.1 noro 7807: {
1.7 noro 7808: int i,j,k,l,inv,a,rank,s;
7809: unsigned int *t,*pivot,*pk;
7810: unsigned int **mat;
7811:
7812: mat = (unsigned int **)mat0;
7813: for ( rank = 0, j = 0; j < col; j++ ) {
7814: for ( i = rank; i < row; i++ )
7815: if ( mat[i][j] )
7816: break;
7817: if ( i == row ) {
7818: colstat[j] = 0;
7819: continue;
7820: } else
7821: colstat[j] = 1;
7822: if ( i != rank ) {
7823: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
7824: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
7825: }
7826: pivot = mat[rank];
7827: s = sugar[rank];
7828: inv = _invsf(pivot[j]);
7829: for ( k = j, pk = pivot+k; k < col; k++, pk++ )
7830: if ( *pk )
7831: *pk = _mulsf(*pk,inv);
7832: for ( i = rank+1; i < row; i++ ) {
7833: t = mat[i];
7834: if ( (a = t[j]) != 0 ) {
7835: sugar[i] = MAX(sugar[i],s);
7836: red_by_vect_sf(md,t+j,pivot+j,_chsgnsf(a),col-j);
7837: }
7838: }
7839: rank++;
7840: }
7841: for ( j = col-1, l = rank-1; j >= 0; j-- )
7842: if ( colstat[j] ) {
7843: pivot = mat[l];
7844: s = sugar[l];
7845: for ( i = 0; i < l; i++ ) {
7846: t = mat[i];
7847: if ( (a = t[j]) != 0 ) {
7848: sugar[i] = MAX(sugar[i],s);
7849: red_by_vect_sf(md,t+j,pivot+j,_chsgnsf(a),col-j);
7850: }
7851: }
7852: l--;
7853: }
7854: return rank;
7855: }
1.1 noro 7856:
1.7 noro 7857: int ndv_ishomo(NDV p)
7858: {
7859: NMV m;
7860: int len,h;
1.1 noro 7861:
7862: if ( !p ) return 1;
7863: len = LEN(p);
7864: m = BDY(p);
7865: h = TD(DL(m));
7866: NMV_ADV(m);
7867: for ( len--; len; len--, NMV_ADV(m) )
7868: if ( TD(DL(m)) != h ) return 0;
7869: return 1;
7870: }
7871:
7872: void ndv_save(NDV p,int index)
7873: {
7874: FILE *s;
7875: char name[BUFSIZ];
7876: short id;
7877: int nv,sugar,len,n,i,td,e,j;
7878: NMV m;
7879: unsigned int *dl;
7880: int mpos;
7881:
7882: sprintf(name,"%s/%d",Demand,index);
7883: s = fopen(name,"w");
7884: savevl(s,0);
7885: if ( !p ) {
7886: saveobj(s,0);
7887: return;
7888: }
7889: id = O_DP;
7890: nv = NV(p);
7891: sugar = SG(p);
7892: len = LEN(p);
7893: write_short(s,(unsigned short *)&id); write_int(s,(unsigned int *)&nv); write_int(s,(unsigned int *)&sugar);
7894: write_int(s,(unsigned int *)&len);
7895:
7896: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
1.6 noro 7897: saveobj(s,(Obj)CZ(m));
1.1 noro 7898: dl = DL(m);
7899: td = TD(dl);
7900: write_int(s,(unsigned int *)&td);
7901: for ( j = 0; j < nv; j++ ) {
7902: e = GET_EXP(dl,j);
7903: write_int(s,(unsigned int *)&e);
7904: }
7905: if ( nd_module ) {
7906: mpos = MPOS(dl); write_int(s,(unsigned int *)&mpos);
7907: }
7908: }
7909: fclose(s);
7910: }
7911:
7912: void nd_save_mod(ND p,int index)
7913: {
7914: FILE *s;
7915: char name[BUFSIZ];
7916: int nv,sugar,len,c;
7917: NM m;
7918:
7919: sprintf(name,"%s/%d",Demand,index);
7920: s = fopen(name,"w");
7921: if ( !p ) {
7922: len = 0;
7923: write_int(s,(unsigned int *)&len);
7924: fclose(s);
7925: return;
7926: }
7927: nv = NV(p);
7928: sugar = SG(p);
7929: len = LEN(p);
7930: write_int(s,(unsigned int *)&nv); write_int(s,(unsigned int *)&sugar); write_int(s,(unsigned int *)&len);
7931: for ( m = BDY(p); m; m = NEXT(m) ) {
7932: c = CM(m); write_int(s,(unsigned int *)&c);
7933: write_intarray(s,(unsigned int *)DL(m),nd_wpd);
7934: }
7935: fclose(s);
7936: }
7937:
7938: NDV ndv_load(int index)
7939: {
7940: FILE *s;
7941: char name[BUFSIZ];
7942: short id;
7943: int nv,sugar,len,n,i,td,e,j;
7944: NDV d;
7945: NMV m0,m;
7946: unsigned int *dl;
7947: Obj obj;
7948: int mpos;
7949:
7950: sprintf(name,"%s/%d",Demand,index);
7951: s = fopen(name,"r");
7952: if ( !s ) return 0;
7953:
7954: skipvl(s);
7955: read_short(s,(unsigned short *)&id);
7956: if ( !id ) return 0;
7957: read_int(s,(unsigned int *)&nv);
7958: read_int(s,(unsigned int *)&sugar);
7959: read_int(s,(unsigned int *)&len);
7960:
7961: m0 = m = MALLOC(len*nmv_adv);
7962: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
1.6 noro 7963: loadobj(s,&obj); CZ(m) = (Z)obj;
1.1 noro 7964: dl = DL(m);
7965: ndl_zero(dl);
7966: read_int(s,(unsigned int *)&td); TD(dl) = td;
7967: for ( j = 0; j < nv; j++ ) {
7968: read_int(s,(unsigned int *)&e);
7969: PUT_EXP(dl,j,e);
7970: }
7971: if ( nd_module ) {
7972: read_int(s,(unsigned int *)&mpos); MPOS(dl) = mpos;
7973: }
7974: if ( nd_blockmask ) ndl_weight_mask(dl);
7975: }
7976: fclose(s);
7977: MKNDV(nv,m0,len,d);
7978: SG(d) = sugar;
7979: return d;
7980: }
7981:
7982: ND nd_load_mod(int index)
7983: {
7984: FILE *s;
7985: char name[BUFSIZ];
7986: int nv,sugar,len,i,c;
7987: ND d;
7988: NM m0,m;
7989:
7990: sprintf(name,"%s/%d",Demand,index);
7991: s = fopen(name,"r");
7992: /* if the file does not exist, it means p[index]=0 */
7993: if ( !s ) return 0;
7994:
7995: read_int(s,(unsigned int *)&nv);
7996: if ( !nv ) { fclose(s); return 0; }
7997:
7998: read_int(s,(unsigned int *)&sugar);
7999: read_int(s,(unsigned int *)&len);
8000: for ( m0 = 0, i = 0; i < len; i++ ) {
8001: NEXTNM(m0,m);
8002: read_int(s,(unsigned int *)&c); CM(m) = c;
8003: read_intarray(s,(unsigned int *)DL(m),nd_wpd);
8004: }
8005: NEXT(m) = 0;
8006: MKND(nv,m0,len,d);
8007: SG(d) = sugar;
8008: fclose(s);
8009: return d;
8010: }
8011:
8012: void nd_det(int mod,MAT f,P *rp)
8013: {
8014: VL fv,tv;
8015: int n,i,j,max,e,nvar,sgn,k0,l0,len0,len,k,l,a;
8016: pointer **m;
8017: P **w;
8018: P mp,r;
8019: NDV **dm;
8020: NDV *t,*mi,*mj;
8021: NDV d,s,mij,mjj;
8022: ND u;
8023: NMV nmv;
8024: UINT *bound;
8025: PGeoBucket bucket;
8026: struct order_spec *ord;
8027: Z dq,dt,ds;
8028: Z mone;
8029: Z gn,qn,dn0,nm,dn;
8030:
8031: create_order_spec(0,0,&ord);
8032: nd_init_ord(ord);
8033: get_vars((Obj)f,&fv);
8034: if ( f->row != f->col )
8035: error("nd_det : non-square matrix");
8036: n = f->row;
8037: m = f->body;
8038: for ( nvar = 0, tv = fv; tv; tv = NEXT(tv), nvar++ );
8039:
8040: if ( !nvar ) {
8041: if ( !mod )
8042: detp(CO,(P **)m,n,rp);
8043: else {
8044: w = (P **)almat_pointer(n,n);
8045: for ( i = 0; i < n; i++ )
8046: for ( j = 0; j < n; j++ )
8047: ptomp(mod,(P)m[i][j],&w[i][j]);
8048: detmp(CO,mod,w,n,&mp);
8049: mptop(mp,rp);
8050: }
8051: return;
8052: }
8053:
8054: if ( !mod ) {
8055: w = (P **)almat_pointer(n,n);
8056: dq = ONE;
8057: for ( i = 0; i < n; i++ ) {
8058: dn0 = ONE;
8059: for ( j = 0; j < n; j++ ) {
8060: if ( !m[i][j] ) continue;
8061: lgp(m[i][j],&nm,&dn);
1.6 noro 8062: gcdz(dn0,dn,&gn); divsz(dn0,gn,&qn); mulz(qn,dn,&dn0);
1.1 noro 8063: }
8064: if ( !UNIZ(dn0) ) {
8065: ds = dn0;
8066: for ( j = 0; j < n; j++ )
8067: mulp(CO,(P)m[i][j],(P)ds,&w[i][j]);
8068: mulz(dq,ds,&dt); dq = dt;
8069: } else
8070: for ( j = 0; j < n; j++ )
8071: w[i][j] = (P)m[i][j];
8072: }
8073: m = (pointer **)w;
8074: }
8075:
8076: for ( i = 0, max = 1; i < n; i++ )
8077: for ( j = 0; j < n; j++ )
8078: for ( tv = fv; tv; tv = NEXT(tv) ) {
8079: e = getdeg(tv->v,(P)m[i][j]);
8080: max = MAX(e,max);
8081: }
8082: nd_setup_parameters(nvar,max);
8083: dm = (NDV **)almat_pointer(n,n);
8084: for ( i = 0, max = 1; i < n; i++ )
8085: for ( j = 0; j < n; j++ ) {
8086: dm[i][j] = ptondv(CO,fv,m[i][j]);
8087: if ( mod ) ndv_mod(mod,dm[i][j]);
8088: if ( dm[i][j] && !LEN(dm[i][j]) ) dm[i][j] = 0;
8089: }
8090: d = ptondv(CO,fv,(P)ONE);
8091: if ( mod ) ndv_mod(mod,d);
8092: chsgnz(ONE,&mone);
8093: for ( j = 0, sgn = 1; j < n; j++ ) {
8094: if ( DP_Print ) {
8095: fprintf(asir_out,".");
8096: }
8097: for ( i = j; i < n && !dm[i][j]; i++ );
8098: if ( i == n ) {
8099: *rp = 0;
8100: return;
8101: }
8102: k0 = i; l0 = j; len0 = LEN(dm[k0][l0]);
8103: for ( k = j; k < n; k++ )
8104: for ( l = j; l < n; l++ )
8105: if ( dm[k][l] && LEN(dm[k][l]) < len0 ) {
8106: k0 = k; l0 = l; len0 = LEN(dm[k][l]);
8107: }
8108: if ( k0 != j ) {
8109: t = dm[j]; dm[j] = dm[k0]; dm[k0] = t;
8110: sgn = -sgn;
8111: }
8112: if ( l0 != j ) {
8113: for ( k = j; k < n; k++ ) {
8114: s = dm[k][j]; dm[k][j] = dm[k][l0]; dm[k][l0] = s;
8115: }
8116: sgn = -sgn;
8117: }
8118: bound = nd_det_compute_bound(dm,n,j);
8119: for ( k = 0; k < nd_nvar; k++ )
8120: if ( bound[k]*2 > nd_mask0 ) break;
8121: if ( k < nd_nvar )
8122: nd_det_reconstruct(dm,n,j,d);
8123:
8124: for ( i = j+1, mj = dm[j], mjj = mj[j]; i < n; i++ ) {
8125: /* if ( DP_Print ) fprintf(asir_out," i=%d\n ",i); */
8126: mi = dm[i]; mij = mi[j];
8127: if ( mod )
8128: ndv_mul_c(mod,mij,mod-1);
8129: else
8130: ndv_mul_c_q(mij,mone);
8131: for ( k = j+1; k < n; k++ ) {
8132: /* if ( DP_Print ) fprintf(asir_out,"k=%d ",k); */
8133: bucket = create_pbucket();
8134: if ( mi[k] ) {
8135: nmv = BDY(mjj); len = LEN(mjj);
8136: for ( a = 0; a < len; a++, NMV_ADV(nmv) ) {
8137: u = ndv_mul_nmv_trunc(mod,nmv,mi[k],DL(BDY(d)));
8138: add_pbucket(mod,bucket,u);
8139: }
8140: }
8141: if ( mj[k] && mij ) {
8142: nmv = BDY(mij); len = LEN(mij);
8143: for ( a = 0; a < len; a++, NMV_ADV(nmv) ) {
8144: u = ndv_mul_nmv_trunc(mod,nmv,mj[k],DL(BDY(d)));
8145: add_pbucket(mod,bucket,u);
8146: }
8147: }
8148: u = nd_quo(mod,bucket,d);
8149: mi[k] = ndtondv(mod,u);
8150: }
8151: /* if ( DP_Print ) fprintf(asir_out,"\n",k); */
8152: }
8153: d = mjj;
8154: }
8155: if ( DP_Print ) {
8156: fprintf(asir_out,"\n");
8157: }
8158: if ( sgn < 0 ) {
8159: if ( mod )
8160: ndv_mul_c(mod,d,mod-1);
8161: else
8162: ndv_mul_c_q(d,mone);
8163: }
8164: r = ndvtop(mod,CO,fv,d);
8165: if ( !mod && !UNIQ(dq) )
8166: divsp(CO,r,(P)dq,rp);
8167: else
8168: *rp = r;
8169: }
8170:
8171: ND ndv_mul_nmv_trunc(int mod,NMV m0,NDV p,UINT *d)
8172: {
8173: NM mr,mr0;
8174: NM tnm;
8175: NMV m;
8176: UINT *d0,*dt,*dm;
8177: int c,n,td,i,c1,c2,len;
8178: Z q;
8179: ND r;
8180:
8181: if ( !p ) return 0;
8182: else {
8183: n = NV(p); m = BDY(p); len = LEN(p);
8184: d0 = DL(m0);
8185: td = TD(d);
8186: mr0 = 0;
8187: NEWNM(tnm);
8188: if ( mod ) {
8189: c = CM(m0);
8190: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
8191: ndl_add(DL(m),d0,DL(tnm));
8192: if ( ndl_reducible(DL(tnm),d) ) {
8193: NEXTNM(mr0,mr);
8194: c1 = CM(m); DMAR(c1,c,0,mod,c2); CM(mr) = c2;
8195: ndl_copy(DL(tnm),DL(mr));
8196: }
8197: }
8198: } else {
1.6 noro 8199: q = CZ(m0);
1.1 noro 8200: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
8201: ndl_add(DL(m),d0,DL(tnm));
8202: if ( ndl_reducible(DL(tnm),d) ) {
8203: NEXTNM(mr0,mr);
1.6 noro 8204: mulz(CZ(m),q,&CZ(mr));
1.1 noro 8205: ndl_copy(DL(tnm),DL(mr));
8206: }
8207: }
8208: }
8209: if ( !mr0 )
8210: return 0;
8211: else {
8212: NEXT(mr) = 0;
8213: for ( len = 0, mr = mr0; mr; mr = NEXT(mr), len++ );
8214: MKND(NV(p),mr0,len,r);
8215: SG(r) = SG(p) + TD(d0);
8216: return r;
8217: }
8218: }
8219: }
8220:
8221: void nd_det_reconstruct(NDV **dm,int n,int j,NDV d)
8222: {
8223: int i,obpe,oadv,h,k,l;
8224: static NM prev_nm_free_list;
8225: EPOS oepos;
8226:
8227: obpe = nd_bpe;
8228: oadv = nmv_adv;
8229: oepos = nd_epos;
8230: if ( obpe < 2 ) nd_bpe = 2;
8231: else if ( obpe < 3 ) nd_bpe = 3;
8232: else if ( obpe < 4 ) nd_bpe = 4;
8233: else if ( obpe < 5 ) nd_bpe = 5;
8234: else if ( obpe < 6 ) nd_bpe = 6;
8235: else if ( obpe < 8 ) nd_bpe = 8;
8236: else if ( obpe < 10 ) nd_bpe = 10;
8237: else if ( obpe < 16 ) nd_bpe = 16;
8238: else if ( obpe < 32 ) nd_bpe = 32;
8239: else error("nd_det_reconstruct : exponent too large");
8240:
8241: nd_setup_parameters(nd_nvar,0);
8242: prev_nm_free_list = _nm_free_list;
8243: _nm_free_list = 0;
8244: for ( k = j; k < n; k++ )
8245: for (l = j; l < n; l++ )
8246: ndv_realloc(dm[k][l],obpe,oadv,oepos);
8247: ndv_realloc(d,obpe,oadv,oepos);
8248: prev_nm_free_list = 0;
8249: #if 0
8250: GC_gcollect();
8251: #endif
8252: }
8253:
8254: /* returns a UINT array containing degree bounds */
8255:
8256: UINT *nd_det_compute_bound(NDV **dm,int n,int j)
8257: {
8258: UINT *d0,*d1,*d,*t,*r;
8259: int k,l,i;
8260:
8261: d0 = (UINT *)MALLOC(nd_nvar*sizeof(UINT));
8262: for ( k = 0; k < nd_nvar; k++ ) d0[k] = 0;
8263: for ( k = j; k < n; k++ )
8264: for ( l = j; l < n; l++ )
8265: if ( dm[k][l] ) {
8266: d = ndv_compute_bound(dm[k][l]);
8267: for ( i = 0; i < nd_nvar; i++ )
8268: d0[i] = MAX(d0[i],d[i]);
8269: }
8270: return d0;
8271: }
8272:
8273: DL nd_separate_d(UINT *d,UINT *trans)
8274: {
8275: int n,td,i,e,j;
8276: DL a;
8277:
8278: ndl_zero(trans);
8279: td = 0;
8280: for ( i = 0; i < nd_ntrans; i++ ) {
8281: e = GET_EXP(d,i);
8282: PUT_EXP(trans,i,e);
8283: td += MUL_WEIGHT(e,i);
8284: }
8285: if ( nd_ntrans+nd_nalg < nd_nvar ) {
8286: /* homogenized */
8287: i = nd_nvar-1;
8288: e = GET_EXP(d,i);
8289: PUT_EXP(trans,i,e);
8290: td += MUL_WEIGHT(e,i);
8291: }
8292: TD(trans) = td;
8293: if ( nd_blockmask) ndl_weight_mask(trans);
8294: NEWDL(a,nd_nalg);
8295: td = 0;
8296: for ( i = 0; i < nd_nalg; i++ ) {
8297: j = nd_ntrans+i;
8298: e = GET_EXP(d,j);
8299: a->d[i] = e;
8300: td += e;
8301: }
8302: a->td = td;
8303: return a;
8304: }
8305:
8306: int nd_monic(int mod,ND *p)
8307: {
8308: UINT *trans,*t;
8309: DL alg;
8310: MP mp0,mp;
8311: NM m,m0,m1,ma0,ma,mb,mr0,mr;
8312: ND r;
8313: DL dl;
8314: DP nm;
8315: NDV ndv;
8316: DAlg inv,cd;
8317: ND s,c;
8318: Z l,mul;
8319: Z ln;
8320: int n,ntrans,i,e,td,is_lc,len;
8321: NumberField nf;
8322: struct oEGT eg0,eg1;
8323:
8324: if ( !(nf = get_numberfield()) )
8325: error("nd_monic : current_numberfield is not set");
8326:
8327: /* Q coef -> DAlg coef */
8328: NEWNM(ma0); ma = ma0;
8329: m = BDY(*p);
8330: is_lc = 1;
8331: while ( 1 ) {
8332: NEWMP(mp0); mp = mp0;
1.6 noro 8333: mp->c = (Obj)CZ(m);
1.1 noro 8334: mp->dl = nd_separate_d(DL(m),DL(ma));
8335: NEWNM(mb);
8336: for ( m = NEXT(m); m; m = NEXT(m) ) {
8337: alg = nd_separate_d(DL(m),DL(mb));
8338: if ( !ndl_equal(DL(ma),DL(mb)) )
8339: break;
1.6 noro 8340: NEXTMP(mp0,mp); mp->c = (Obj)CZ(m); mp->dl = alg;
1.1 noro 8341: }
8342: NEXT(mp) = 0;
8343: MKDP(nd_nalg,mp0,nm);
8344: MKDAlg(nm,ONE,cd);
8345: if ( is_lc == 1 ) {
8346: /* if the lc is a rational number, we have nothing to do */
8347: if ( !mp0->dl->td )
8348: return 1;
8349:
8350: get_eg(&eg0);
8351: invdalg(cd,&inv);
8352: get_eg(&eg1); add_eg(&eg_invdalg,&eg0,&eg1);
8353: /* check the validity of inv */
8354: if ( mod && !remqi((Q)inv->dn,mod) )
8355: return 0;
8356: CA(ma) = nf->one;
8357: is_lc = 0;
8358: ln = ONE;
8359: } else {
8360: muldalg(cd,inv,&CA(ma));
8361: lcmz(ln,CA(ma)->dn,&ln);
8362: }
8363: if ( m ) {
8364: NEXT(ma) = mb; ma = mb;
8365: } else {
8366: NEXT(ma) = 0;
8367: break;
8368: }
8369: }
8370: /* l = lcm(denoms) */
8371: l = ln;
8372: for ( mr0 = 0, m = ma0; m; m = NEXT(m) ) {
1.6 noro 8373: divsz(l,CA(m)->dn,&mul);
1.1 noro 8374: for ( mp = BDY(CA(m)->nm); mp; mp = NEXT(mp) ) {
8375: NEXTNM(mr0,mr);
1.6 noro 8376: mulz((Z)mp->c,mul,&CZ(mr));
1.1 noro 8377: dl = mp->dl;
8378: td = TD(DL(m));
8379: ndl_copy(DL(m),DL(mr));
8380: for ( i = 0; i < nd_nalg; i++ ) {
8381: e = dl->d[i];
8382: PUT_EXP(DL(mr),i+nd_ntrans,e);
8383: td += MUL_WEIGHT(e,i+nd_ntrans);
8384: }
8385: if ( nd_module ) MPOS(DL(mr)) = MPOS(DL(m));
8386: TD(DL(mr)) = td;
8387: if ( nd_blockmask) ndl_weight_mask(DL(mr));
8388: }
8389: }
8390: NEXT(mr) = 0;
8391: for ( len = 0, mr = mr0; mr; mr = NEXT(mr), len++ );
8392: MKND(NV(*p),mr0,len,r);
8393: /* XXX */
8394: SG(r) = SG(*p);
8395: nd_free(*p);
8396: *p = r;
8397: return 1;
8398: }
8399:
8400: NODE reverse_node(NODE n)
8401: {
8402: NODE t,t1;
8403:
8404: for ( t = 0; n; n = NEXT(n) ) {
8405: MKNODE(t1,BDY(n),t); t = t1;
8406: }
8407: return t;
8408: }
8409:
8410: P ndc_div(int mod,union oNDC a,union oNDC b)
8411: {
8412: union oNDC c;
8413: int inv,t;
8414:
8415: if ( mod == -1 ) c.m = _mulsf(a.m,_invsf(b.m));
1.10 noro 8416: else if ( mod == -2 ) divlf(a.z,b.z,&c.z);
1.1 noro 8417: else if ( mod ) {
8418: inv = invm(b.m,mod);
8419: DMAR(a.m,inv,0,mod,t); c.m = t;
8420: } else if ( nd_vc )
8421: divsp(nd_vc,a.p,b.p,&c.p);
8422: else
8423: divsz(a.z,b.z,&c.z);
8424: return ndctop(mod,c);
8425: }
8426:
8427: P ndctop(int mod,union oNDC c)
8428: {
8429: Z q;
8430: int e;
8431: GFS gfs;
8432:
8433: if ( mod == -1 ) {
8434: e = IFTOF(c.m); MKGFS(e,gfs); return (P)gfs;
8435: } else if ( mod == -2 ) {
1.10 noro 8436: q = c.z; return (P)q;
1.1 noro 8437: } else if ( mod > 0 ) {
1.6 noro 8438: STOZ(c.m,q); return (P)q;
1.1 noro 8439: } else
8440: return (P)c.p;
8441: }
8442:
8443: /* [0,0,0,cont] = p -> p/cont */
8444:
8445: void finalize_tracelist(int i,P cont)
8446: {
8447: LIST l;
8448: NODE node;
8449: Z iq;
8450:
8451: if ( !UNIQ(cont) ) {
8452: node = mknode(4,NULLP,NULLP,NULLP,cont);
8453: MKLIST(l,node); MKNODE(node,l,nd_tracelist);
8454: nd_tracelist = node;
8455: }
1.6 noro 8456: STOZ(i,iq);
1.1 noro 8457: nd_tracelist = reverse_node(nd_tracelist);
8458: MKLIST(l,nd_tracelist);
8459: node = mknode(2,iq,l); MKLIST(l,node);
8460: MKNODE(node,l,nd_alltracelist); MKLIST(l,node);
8461: nd_alltracelist = node; nd_tracelist = 0;
8462: }
8463:
8464: void conv_ilist(int demand,int trace,NODE g,int **indp)
8465: {
8466: int n,i,j;
8467: int *ind;
8468: NODE t;
8469:
8470: n = length(g);
8471: ind = (int *)MALLOC(n*sizeof(int));
8472: for ( i = 0, t = g; i < n; i++, t = NEXT(t) ) {
8473: j = (long)BDY(t); ind[i] = j;
8474: BDY(t) = (pointer)(demand?ndv_load(j):(trace?nd_ps_trace[j]:nd_ps[j]));
8475: }
8476: if ( indp ) *indp = ind;
8477: }
8478:
8479: void parse_nd_option(NODE opt)
8480: {
8481: NODE t,p,u;
8482: int i,s,n;
8483: char *key;
8484: Obj value;
8485:
8486: nd_gentrace = 0; nd_gensyz = 0; nd_nora = 0; nd_gbblock = 0;
8487: nd_newelim = 0; nd_intersect = 0; nd_nzlist = 0;
8488: nd_splist = 0; nd_check_splist = 0;
8489: nd_sugarweight = 0;
8490: nd_f4red =0;
8491: nd_rank0 = 0;
8492: for ( t = opt; t; t = NEXT(t) ) {
8493: p = BDY((LIST)BDY(t));
8494: key = BDY((STRING)BDY(p));
8495: value = (Obj)BDY(NEXT(p));
8496: if ( !strcmp(key,"gentrace") )
8497: nd_gentrace = value?1:0;
8498: else if ( !strcmp(key,"gensyz") )
8499: nd_gensyz = value?1:0;
8500: else if ( !strcmp(key,"nora") )
8501: nd_nora = value?1:0;
8502: else if ( !strcmp(key,"gbblock") ) {
8503: if ( value && OID(value) == O_LIST ) {
8504: u = BDY((LIST)value);
8505: nd_gbblock = MALLOC((2*length(u)+1)*sizeof(int));
8506: for ( i = 0; u; u = NEXT(u) ) {
8507: p = BDY((LIST)BDY(u));
1.6 noro 8508: s = nd_gbblock[i++] = ZTOS((Q)BDY(p));
8509: nd_gbblock[i++] = s+ZTOS((Q)BDY(NEXT(p)))-1;
1.1 noro 8510: }
8511: nd_gbblock[i] = -1;
8512: } else
8513: nd_gbblock = 0;
8514: } else if ( !strcmp(key,"newelim") )
8515: nd_newelim = value?1:0;
8516: else if ( !strcmp(key,"intersect") )
8517: nd_intersect = value?1:0;
1.17 noro 8518: else if ( !strcmp(key,"syzgen") )
8519: nd_intersect = ZTOS((Q)value);
1.1 noro 8520: else if ( !strcmp(key,"lf") )
8521: nd_lf = value?1:0;
8522: else if ( !strcmp(key,"trace") ) {
8523: if ( value ) {
8524: u = BDY((LIST)value);
8525: nd_nzlist = BDY((LIST)ARG2(u));
1.6 noro 8526: nd_bpe = ZTOS((Q)ARG3(u));
1.1 noro 8527: }
8528: } else if ( !strcmp(key,"f4red") ) {
1.6 noro 8529: nd_f4red = ZTOS((Q)value);
1.1 noro 8530: } else if ( !strcmp(key,"rank0") ) {
8531: nd_rank0 = value?1:0;
8532: } else if ( !strcmp(key,"splist") ) {
8533: nd_splist = value?1:0;
8534: } else if ( !strcmp(key,"check_splist") ) {
8535: nd_check_splist = BDY((LIST)value);
8536: } else if ( !strcmp(key,"sugarweight") ) {
8537: u = BDY((LIST)value);
8538: n = length(u);
8539: nd_sugarweight = MALLOC(n*sizeof(int));
8540: for ( i = 0; i < n; i++, u = NEXT(u) )
1.6 noro 8541: nd_sugarweight[i] = ZTOS((Q)BDY(u));
1.1 noro 8542: }
8543: }
8544: }
8545:
8546: ND mdptond(DP d);
8547: ND nd_mul_nm(int mod,NM m0,ND p);
8548: ND nd_mul_nm_lf(NM m0,ND p);
8549: ND *btog(NODE ti,ND **p,int nb,int mod);
8550: ND btog_one(NODE ti,ND *p,int nb,int mod);
8551: MAT nd_btog(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,MAT *rp);
8552: VECT nd_btog_one(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,int pos,MAT *rp);
8553:
8554: /* d:monomial */
8555: ND mdptond(DP d)
8556: {
8557: NM m;
8558: ND r;
8559:
8560: if ( OID(d) == 1 )
8561: r = ptond(CO,CO,(P)d);
8562: else {
8563: NEWNM(m);
8564: dltondl(NV(d),BDY(d)->dl,DL(m));
1.6 noro 8565: CZ(m) = (Z)BDY(d)->c;
1.1 noro 8566: NEXT(m) = 0;
8567: MKND(NV(d),m,1,r);
8568: }
8569: return r;
8570: }
8571:
8572: ND nd_mul_nm(int mod,NM m0,ND p)
8573: {
8574: UINT *d0;
8575: int c0,c1,c;
8576: NM tm,mr,mr0;
8577: ND r;
8578:
8579: if ( !p ) return 0;
8580: d0 = DL(m0);
8581: c0 = CM(m0);
8582: mr0 = 0;
8583: for ( tm = BDY(p); tm; tm = NEXT(tm) ) {
8584: NEXTNM(mr0,mr);
8585: c = CM(tm); DMAR(c0,c,0,mod,c1); CM(mr) = c1;
8586: ndl_add(d0,DL(tm),DL(mr));
8587: }
8588: NEXT(mr) = 0;
8589: MKND(NV(p),mr0,LEN(p),r);
8590: return r;
8591: }
8592:
8593: ND nd_mul_nm_lf(NM m0,ND p)
8594: {
8595: UINT *d0;
8596: Z c0,c1,c;
8597: NM tm,mr,mr0;
8598: ND r;
8599:
8600: if ( !p ) return 0;
8601: d0 = DL(m0);
8602: c0 = CZ(m0);
8603: mr0 = 0;
8604: for ( tm = BDY(p); tm; tm = NEXT(tm) ) {
8605: NEXTNM(mr0,mr);
8606: c = CZ(tm); mullf(c0,CZ(tm),&c1); CZ(mr) = c1;
8607: ndl_add(d0,DL(tm),DL(mr));
8608: }
8609: NEXT(mr) = 0;
8610: MKND(NV(p),mr0,LEN(p),r);
8611: return r;
8612: }
8613:
8614: ND *btog(NODE ti,ND **p,int nb,int mod)
8615: {
8616: PGeoBucket *r;
8617: int i,ci;
8618: NODE t,s;
8619: ND m,tp;
8620: ND *pi,*rd;
8621: P c;
8622:
8623: r = (PGeoBucket *)MALLOC(nb*sizeof(PGeoBucket));
8624: for ( i = 0; i < nb; i++ )
8625: r[i] = create_pbucket();
8626: for ( t = ti; t; t = NEXT(t) ) {
8627: s = BDY((LIST)BDY(t));
8628: if ( ARG0(s) ) {
8629: m = mdptond((DP)ARG2(s));
1.6 noro 8630: ptomp(mod,(P)HCZ(m),&c);
1.1 noro 8631: if ( (ci = ((MQ)c)->cont) != 0 ) {
8632: HCM(m) = ci;
1.6 noro 8633: pi = p[ZTOS((Q)ARG1(s))];
1.1 noro 8634: for ( i = 0; i < nb; i++ ) {
8635: tp = nd_mul_nm(mod,BDY(m),pi[i]);
8636: add_pbucket(mod,r[i],tp);
8637: }
8638: }
8639: ci = 1;
8640: } else {
8641: ptomp(mod,(P)ARG3(s),&c); ci = ((MQ)c)->cont;
8642: ci = invm(ci,mod);
8643: }
8644: }
8645: rd = (ND *)MALLOC(nb*sizeof(ND));
8646: for ( i = 0; i < nb; i++ )
8647: rd[i] = normalize_pbucket(mod,r[i]);
8648: if ( ci != 1 )
8649: for ( i = 0; i < nb; i++ ) nd_mul_c(mod,rd[i],ci);
8650: return rd;
8651: }
8652:
8653: /* YYY */
8654: ND *btog_lf(NODE ti,ND **p,int nb)
8655: {
8656: PGeoBucket *r;
8657: int i;
8658: NODE t,s;
8659: ND m,tp;
8660: ND *pi,*rd;
8661: LM lm;
8662: Z lf,c;
8663:
8664: r = (PGeoBucket *)MALLOC(nb*sizeof(PGeoBucket));
8665: for ( i = 0; i < nb; i++ )
8666: r[i] = create_pbucket();
8667: for ( t = ti; t; t = NEXT(t) ) {
8668: s = BDY((LIST)BDY(t));
8669: if ( ARG0(s) ) {
8670: m = mdptond((DP)ARG2(s));
1.6 noro 8671: simp_ff((Obj)HCZ(m),(Obj *)&lm);
1.1 noro 8672: if ( lm ) {
8673: lmtolf(lm,&lf); HCZ(m) = lf;
1.6 noro 8674: pi = p[ZTOS((Q)ARG1(s))];
1.1 noro 8675: for ( i = 0; i < nb; i++ ) {
8676: tp = nd_mul_nm_lf(BDY(m),pi[i]);
8677: add_pbucket(-2,r[i],tp);
8678: }
8679: }
8680: c = ONE;
8681: } else {
8682: simp_ff((Obj)ARG3(s),(Obj *)&lm); lmtolf(lm,&lf); invz(lf,current_mod_lf,&c);
8683: }
8684: }
8685: rd = (ND *)MALLOC(nb*sizeof(ND));
8686: for ( i = 0; i < nb; i++ )
8687: rd[i] = normalize_pbucket(-2,r[i]);
8688: for ( i = 0; i < nb; i++ ) nd_mul_c_lf(rd[i],c);
8689: return rd;
8690: }
8691:
8692: ND btog_one(NODE ti,ND *p,int nb,int mod)
8693: {
8694: PGeoBucket r;
8695: int i,ci,j;
8696: NODE t,s;
8697: ND m,tp;
8698: ND pi,rd;
8699: P c;
8700:
8701: r = create_pbucket();
8702: for ( t = ti; t; t = NEXT(t) ) {
8703: s = BDY((LIST)BDY(t));
8704: if ( ARG0(s) ) {
8705: m = mdptond((DP)ARG2(s));
1.6 noro 8706: ptomp(mod,(P)HCZ(m),&c);
1.1 noro 8707: if ( (ci = ((MQ)c)->cont) != 0 ) {
8708: HCM(m) = ci;
1.6 noro 8709: pi = p[j=ZTOS((Q)ARG1(s))];
1.1 noro 8710: if ( !pi ) {
8711: pi = nd_load_mod(j);
8712: tp = nd_mul_nm(mod,BDY(m),pi);
8713: nd_free(pi);
8714: add_pbucket(mod,r,tp);
8715: } else {
8716: tp = nd_mul_nm(mod,BDY(m),pi);
8717: add_pbucket(mod,r,tp);
8718: }
8719: }
8720: ci = 1;
8721: } else {
8722: ptomp(mod,(P)ARG3(s),&c); ci = ((MQ)c)->cont;
8723: ci = invm(ci,mod);
8724: }
8725: }
8726: rd = normalize_pbucket(mod,r);
8727: free_pbucket(r);
8728: if ( ci != 1 ) nd_mul_c(mod,rd,ci);
8729: return rd;
8730: }
8731:
8732: MAT nd_btog_lf(LIST f,LIST v,struct order_spec *ord,LIST tlist,MAT *rp);
8733:
8734: MAT nd_btog(LIST f,LIST v,int mod,struct order_spec *ord,LIST tlist,MAT *rp)
8735: {
8736: int i,j,n,m,nb,pi0,pi1,nvar;
8737: VL fv,tv,vv;
8738: NODE permtrace,perm,trace,intred,ind,t,pi,ti;
8739: ND **p;
8740: ND *c;
8741: ND u;
8742: P inv;
8743: MAT mat;
8744:
8745: if ( mod == -2 )
8746: return nd_btog_lf(f,v,ord,tlist,rp);
8747:
8748: parse_nd_option(current_option);
8749: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
8750: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
8751: switch ( ord->id ) {
8752: case 1:
8753: if ( ord->nv != nvar )
8754: error("nd_check : invalid order specification");
8755: break;
8756: default:
8757: break;
8758: }
8759: nd_init_ord(ord);
8760: #if 0
1.6 noro 8761: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 8762: #else
8763: nd_bpe = 32;
8764: #endif
8765: nd_setup_parameters(nvar,0);
8766: permtrace = BDY((LIST)ARG2(BDY(tlist)));
8767: intred = BDY((LIST)ARG3(BDY(tlist)));
8768: ind = BDY((LIST)ARG4(BDY(tlist)));
8769: perm = BDY((LIST)BDY(permtrace)); trace =NEXT(permtrace);
8770: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 8771: j = ZTOS((Q)BDY(BDY((LIST)BDY(t))));
1.1 noro 8772: if ( j > i ) i = j;
8773: }
8774: n = i+1;
8775: nb = length(BDY(f));
8776: p = (ND **)MALLOC(n*sizeof(ND *));
8777: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
8778: pi = BDY((LIST)BDY(t));
1.6 noro 8779: pi0 = ZTOS((Q)ARG0(pi)); pi1 = ZTOS((Q)ARG1(pi));
1.1 noro 8780: p[pi0] = c = (ND *)MALLOC(nb*sizeof(ND));
8781: ptomp(mod,(P)ARG2(pi),&inv);
8782: ((MQ)inv)->cont = invm(((MQ)inv)->cont,mod);
8783: u = ptond(CO,vv,(P)ONE);
8784: HCM(u) = ((MQ)inv)->cont;
8785: c[pi1] = u;
8786: }
8787: for ( t = trace,i=0; t; t = NEXT(t), i++ ) {
8788: printf("%d ",i); fflush(stdout);
8789: ti = BDY((LIST)BDY(t));
1.6 noro 8790: p[j=ZTOS((Q)ARG0(ti))] = btog(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 8791: }
8792: for ( t = intred, i=0; t; t = NEXT(t), i++ ) {
8793: printf("%d ",i); fflush(stdout);
8794: ti = BDY((LIST)BDY(t));
1.6 noro 8795: p[j=ZTOS((Q)ARG0(ti))] = btog(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 8796: }
8797: m = length(ind);
8798: MKMAT(mat,nb,m);
8799: for ( j = 0, t = ind; j < m; j++, t = NEXT(t) )
1.6 noro 8800: for ( i = 0, c = p[ZTOS((Q)BDY(t))]; i < nb; i++ )
1.1 noro 8801: BDY(mat)[i][j] = ndtodp(mod,c[i]);
8802: return mat;
8803: }
8804:
8805: MAT nd_btog_lf(LIST f,LIST v,struct order_spec *ord,LIST tlist,MAT *rp)
8806: {
8807: int i,j,n,m,nb,pi0,pi1,nvar;
8808: VL fv,tv,vv;
8809: NODE permtrace,perm,trace,intred,ind,t,pi,ti;
8810: ND **p;
8811: ND *c;
8812: ND u;
8813: MAT mat;
8814: LM lm;
8815: Z lf,inv;
8816:
8817: parse_nd_option(current_option);
8818: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
8819: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
8820: switch ( ord->id ) {
8821: case 1:
8822: if ( ord->nv != nvar )
8823: error("nd_check : invalid order specification");
8824: break;
8825: default:
8826: break;
8827: }
8828: nd_init_ord(ord);
8829: #if 0
1.6 noro 8830: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 8831: #else
8832: nd_bpe = 32;
8833: #endif
8834: nd_setup_parameters(nvar,0);
8835: permtrace = BDY((LIST)ARG2(BDY(tlist)));
8836: intred = BDY((LIST)ARG3(BDY(tlist)));
8837: ind = BDY((LIST)ARG4(BDY(tlist)));
8838: perm = BDY((LIST)BDY(permtrace)); trace =NEXT(permtrace);
8839: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 8840: j = ZTOS((Q)BDY(BDY((LIST)BDY(t))));
1.1 noro 8841: if ( j > i ) i = j;
8842: }
8843: n = i+1;
8844: nb = length(BDY(f));
8845: p = (ND **)MALLOC(n*sizeof(ND *));
8846: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
8847: pi = BDY((LIST)BDY(t));
1.6 noro 8848: pi0 = ZTOS((Q)ARG0(pi)); pi1 = ZTOS((Q)ARG1(pi));
1.1 noro 8849: p[pi0] = c = (ND *)MALLOC(nb*sizeof(ND));
8850: simp_ff((Obj)ARG2(pi),(Obj *)&lm); lmtolf(lm,&lf); invz(lf,current_mod_lf,&inv);
8851: u = ptond(CO,vv,(P)ONE);
8852: HCZ(u) = inv;
8853: c[pi1] = u;
8854: }
8855: for ( t = trace,i=0; t; t = NEXT(t), i++ ) {
8856: printf("%d ",i); fflush(stdout);
8857: ti = BDY((LIST)BDY(t));
1.6 noro 8858: p[j=ZTOS((Q)ARG0(ti))] = btog_lf(BDY((LIST)ARG1(ti)),p,nb);
1.1 noro 8859: }
8860: for ( t = intred, i=0; t; t = NEXT(t), i++ ) {
8861: printf("%d ",i); fflush(stdout);
8862: ti = BDY((LIST)BDY(t));
1.6 noro 8863: p[j=ZTOS((Q)ARG0(ti))] = btog_lf(BDY((LIST)ARG1(ti)),p,nb);
1.1 noro 8864: }
8865: m = length(ind);
8866: MKMAT(mat,nb,m);
8867: for ( j = 0, t = ind; j < m; j++, t = NEXT(t) )
1.6 noro 8868: for ( i = 0, c = p[ZTOS((Q)BDY(t))]; i < nb; i++ )
1.1 noro 8869: BDY(mat)[i][j] = ndtodp(-2,c[i]);
8870: return mat;
8871: }
8872:
8873: VECT nd_btog_one(LIST f,LIST v,int mod,struct order_spec *ord,
8874: LIST tlist,int pos,MAT *rp)
8875: {
8876: int i,j,n,m,nb,pi0,pi1,nvar;
8877: VL fv,tv,vv;
8878: NODE permtrace,perm,trace,intred,ind,t,pi,ti;
8879: ND *p;
8880: ND *c;
8881: ND u;
8882: P inv;
8883: VECT vect;
8884:
8885: if ( mod == -2 )
8886: error("nd_btog_one : not implemented yet for a large finite field");
8887:
8888: parse_nd_option(current_option);
8889: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
8890: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
8891: switch ( ord->id ) {
8892: case 1:
8893: if ( ord->nv != nvar )
8894: error("nd_check : invalid order specification");
8895: break;
8896: default:
8897: break;
8898: }
8899: nd_init_ord(ord);
8900: #if 0
1.6 noro 8901: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 8902: #else
8903: nd_bpe = 32;
8904: #endif
8905: nd_setup_parameters(nvar,0);
8906: permtrace = BDY((LIST)ARG2(BDY(tlist)));
8907: intred = BDY((LIST)ARG3(BDY(tlist)));
8908: ind = BDY((LIST)ARG4(BDY(tlist)));
8909: perm = BDY((LIST)BDY(permtrace)); trace =NEXT(permtrace);
8910: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 8911: j = ZTOS((Q)BDY(BDY((LIST)BDY(t))));
1.1 noro 8912: if ( j > i ) i = j;
8913: }
8914: n = i+1;
8915: nb = length(BDY(f));
8916: p = (ND *)MALLOC(n*sizeof(ND *));
8917: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
8918: pi = BDY((LIST)BDY(t));
1.6 noro 8919: pi0 = ZTOS((Q)ARG0(pi)); pi1 = ZTOS((Q)ARG1(pi));
1.1 noro 8920: if ( pi1 == pos ) {
8921: ptomp(mod,(P)ARG2(pi),&inv);
8922: ((MQ)inv)->cont = invm(((MQ)inv)->cont,mod);
8923: u = ptond(CO,vv,(P)ONE);
8924: HCM(u) = ((MQ)inv)->cont;
8925: p[pi0] = u;
8926: }
8927: }
8928: for ( t = trace,i=0; t; t = NEXT(t), i++ ) {
8929: printf("%d ",i); fflush(stdout);
8930: ti = BDY((LIST)BDY(t));
1.6 noro 8931: p[j=ZTOS((Q)ARG0(ti))] = btog_one(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 8932: if ( Demand ) {
8933: nd_save_mod(p[j],j); nd_free(p[j]); p[j] = 0;
8934: }
8935: }
8936: for ( t = intred, i=0; t; t = NEXT(t), i++ ) {
8937: printf("%d ",i); fflush(stdout);
8938: ti = BDY((LIST)BDY(t));
1.6 noro 8939: p[j=ZTOS((Q)ARG0(ti))] = btog_one(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 8940: if ( Demand ) {
8941: nd_save_mod(p[j],j); nd_free(p[j]); p[j] = 0;
8942: }
8943: }
8944: m = length(ind);
8945: MKVECT(vect,m);
8946: for ( j = 0, t = ind; j < m; j++, t = NEXT(t) ) {
1.6 noro 8947: u = p[ZTOS((Q)BDY(t))];
1.1 noro 8948: if ( !u ) {
1.6 noro 8949: u = nd_load_mod(ZTOS((Q)BDY(t)));
1.1 noro 8950: BDY(vect)[j] = ndtodp(mod,u);
8951: nd_free(u);
8952: } else
8953: BDY(vect)[j] = ndtodp(mod,u);
8954: }
8955: return vect;
8956: }
8957:
8958: void ndv_print_lf(NDV p)
8959: {
8960: NMV m;
8961: int i,len;
8962:
8963: if ( !p ) printf("0\n");
8964: else {
8965: len = LEN(p);
8966: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
8967: printf("+");
8968: mpz_out_str(asir_out,10,BDY(CZ(m)));
8969: printf("*");
8970: ndl_print(DL(m));
8971: }
8972: printf("\n");
8973: }
8974: }
8975:
8976: void nd_f4_lf_trace(LIST f,LIST v,int trace,int homo,struct order_spec *ord,LIST *rp)
8977: {
8978: VL tv,fv,vv,vc,av;
8979: NODE fd,fd0,in0,in,r,r0,t,s,cand,alist;
8980: int m,nocheck,nvar,mindex,e,max;
8981: NDV c;
8982: NMV a;
8983: P p,zp;
8984: Q dmy;
8985: EPOS oepos;
8986: int obpe,oadv,wmax,i,len,cbpe,ishomo,nalg,mrank,trank,ompos;
8987: Alg alpha,dp;
8988: P poly;
8989: LIST f1,f2,zpl;
8990: Obj obj;
8991: NumberField nf;
8992: struct order_spec *ord1;
8993: struct oEGT eg_check,eg0,eg1;
8994: NODE tr,tl1,tl2,tl3,tl4;
8995: LIST l1,l2,l3,l4,l5;
8996: int *perm;
8997: int j,ret;
8998: NODE retn;
8999: Q jq,bpe;
9000:
9001: nd_module = 0;
9002: parse_nd_option(current_option);
9003: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
9004: if ( nd_vc )
9005: error("nd_f4_lf_trace : computation over a rational function field is not implemented");
9006: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
9007: switch ( ord->id ) {
9008: case 1:
9009: if ( ord->nv != nvar )
9010: error("nd_f4_lf_trace : invalid order specification");
9011: break;
9012: default:
9013: break;
9014: }
9015:
9016: nd_ntrans = nvar;
9017: nd_nalg = 0;
9018:
9019: nocheck = 0;
9020: mindex = 0;
9021:
9022: /* do not use on-demand load/save */
9023: nd_demand = 0;
9024: m = trace > 1 ? trace : get_lprime(mindex);
9025: nd_init_ord(ord);
9026: mrank = 0;
9027: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
9028: for ( tv = vv; tv; tv = NEXT(tv) ) {
9029: if ( nd_module ) {
9030: s = BDY((LIST)BDY(t));
9031: trank = length(s);
9032: mrank = MAX(mrank,trank);
9033: for ( ; s; s = NEXT(s) ) {
9034: e = getdeg(tv->v,(P)BDY(s));
9035: max = MAX(e,max);
9036: }
9037: } else {
9038: e = getdeg(tv->v,(P)BDY(t));
9039: max = MAX(e,max);
9040: }
9041: }
9042: nd_setup_parameters(nvar,max);
9043: obpe = nd_bpe; oadv = nmv_adv; oepos = nd_epos; ompos = nd_mpos;
9044: ishomo = 1;
9045: /* XXX */
9046: for ( in0 = 0, fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
9047: if ( nd_module ) {
9048: c = (pointer)pltondv(CO,vv,(LIST)BDY(t));
9049: } else {
9050: c = (pointer)ptondv(CO,vv,(P)BDY(t));
9051: }
9052: if ( ishomo )
9053: ishomo = ishomo && ndv_ishomo(c);
9054: if ( c ) {
9055: NEXTNODE(fd0,fd); BDY(fd) = (pointer)ndv_dup(0,c);
9056: ndv_mod(-2,c);
9057: NEXTNODE(in0,in); BDY(in) = (pointer)c;
9058: }
9059: }
9060: if ( in0 ) NEXT(in) = 0;
9061: if ( fd0 ) NEXT(fd) = 0;
9062: if ( !ishomo && homo ) {
9063: for ( t = in0, wmax = max; t; t = NEXT(t) ) {
9064: c = (NDV)BDY(t); len = LEN(c);
9065: for ( a = BDY(c), i = 0; i < len; i++, NMV_ADV(a) )
9066: wmax = MAX(TD(DL(a)),wmax);
9067: }
9068: homogenize_order(ord,nvar,&ord1);
9069: nd_init_ord(ord1);
9070: nd_setup_parameters(nvar+1,wmax);
9071: for ( t = fd0; t; t = NEXT(t) )
9072: ndv_homogenize((NDV)BDY(t),obpe,oadv,oepos,ompos);
9073: }
9074: if ( MaxDeg > 0 ) nocheck = 1;
9075: ret = ndv_setup(-2,m,fd0,nd_gbblock?1:0,0);
9076: if ( ret )
9077: cand = nd_f4_lf_trace_main(m,&perm);
9078: if ( !ret || !cand ) {
9079: *rp = 0; return;
9080: }
9081: if ( !ishomo && homo ) {
9082: /* dehomogenization */
9083: for ( t = cand; t; t = NEXT(t) ) ndv_dehomogenize((NDV)BDY(t),ord);
9084: nd_init_ord(ord);
9085: nd_setup_parameters(nvar,0);
9086: }
9087: cand = ndv_reducebase(cand,perm);
9088: cand = ndv_reduceall(-2,cand);
9089: cbpe = nd_bpe;
9090: get_eg(&eg0);
9091: if ( (ret = ndv_check_membership(-2,in0,obpe,oadv,oepos,cand)) != 0 ) {
9092: /* gbcheck : cand is a GB of Id(cand) ? */
9093: retn = nd_f4(-2,0,0);
9094: }
9095: if ( !retn ) {
9096: /* failure */
9097: *rp = 0; return;
9098: }
9099: get_eg(&eg1); init_eg(&eg_check); add_eg(&eg_check,&eg0,&eg1);
9100: if ( DP_Print )
1.5 noro 9101: fprintf(asir_out,"check=%.3fsec\n",eg_check.exectime);
1.1 noro 9102: /* dp->p */
9103: nd_bpe = cbpe;
9104: nd_setup_parameters(nd_nvar,0);
9105: for ( r = cand; r; r = NEXT(r) ) {
9106: if ( nd_module ) BDY(r) = ndvtopl(-2,CO,vv,BDY(r),mrank);
9107: else BDY(r) = (pointer)ndvtop(-2,CO,vv,BDY(r));
9108: }
9109: MKLIST(*rp,cand);
9110: }
9111:
9112: NODE nd_f4_lf_trace_main(int m,int **indp)
9113: {
9114: int i,nh,stat,index;
9115: NODE r,rm,g;
9116: ND_pairs d,l,l0,t;
9117: ND spol,red;
9118: NDV nf,redv,nfqv,nfv;
9119: NM s0,s;
9120: NODE rp0,srp0,nflist,nflist_lf;
9121: int nsp,nred,col,rank,len,k,j,a;
9122: UINT c;
9123: UINT **spmat;
9124: UINT *s0vect,*svect,*p,*v;
9125: int *colstat;
9126: IndArray *imat;
9127: int *rhead;
9128: int spcol,sprow;
9129: int sugar;
9130: PGeoBucket bucket;
9131: struct oEGT eg0,eg1,eg_f4;
9132:
9133: g = 0; d = 0;
9134: for ( i = 0; i < nd_psn; i++ ) {
9135: d = update_pairs(d,g,i,0);
9136: g = update_base(g,i);
9137: }
9138: while ( d ) {
9139: get_eg(&eg0);
9140: l = nd_minsugarp(d,&d);
9141: sugar = SG(l);
9142: if ( MaxDeg > 0 && sugar > MaxDeg ) break;
9143: bucket = create_pbucket();
9144: stat = nd_sp_f4(m,0,l,bucket);
9145: if ( !stat ) {
9146: for ( t = l; NEXT(t); t = NEXT(t) );
9147: NEXT(t) = d; d = l;
9148: d = nd_reconstruct(1,d);
9149: continue;
9150: }
9151: if ( bucket->m < 0 ) continue;
9152: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
9153: if ( !col ) {
9154: for ( t = l; NEXT(t); t = NEXT(t) );
9155: NEXT(t) = d; d = l;
9156: d = nd_reconstruct(1,d);
9157: continue;
9158: }
9159: get_eg(&eg1); init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg1);
9160: if ( DP_Print )
1.5 noro 9161: fprintf(asir_out,"\nsugar=%d,symb=%.3fsec,",sugar,eg_f4.exectime);
1.1 noro 9162: nflist = nd_f4_red(m,l,0,s0vect,col,rp0,&l0);
9163: if ( !l0 ) continue;
9164: l = l0;
9165:
9166: /* over LF */
9167: bucket = create_pbucket();
9168: stat = nd_sp_f4(-2,1,l,bucket);
9169: if ( !stat ) {
9170: for ( t = l; NEXT(t); t = NEXT(t) );
9171: NEXT(t) = d; d = l;
9172: d = nd_reconstruct(1,d);
9173: continue;
9174: }
9175: if ( bucket->m < 0 ) continue;
9176: col = nd_symbolic_preproc(bucket,1,&s0vect,&rp0);
9177: if ( !col ) {
9178: for ( t = l; NEXT(t); t = NEXT(t) );
9179: NEXT(t) = d; d = l;
9180: d = nd_reconstruct(1,d);
9181: continue;
9182: }
9183: nflist_lf = nd_f4_red(-2,l,1,s0vect,col,rp0,0);
9184: /* adding new bases */
9185: for ( rm = nflist, r = nflist_lf; r && rm; rm = NEXT(rm), r = NEXT(r) ) {
9186: nfv = (NDV)BDY(rm);
9187: nfqv = (NDV)BDY(r);
9188: if ( DL_COMPARE(HDL(nfv),HDL(nfqv)) ) return 0;
9189: ndv_removecont(m,nfv);
9190: ndv_removecont(-2,nfqv);
9191: nh = ndv_newps(-2,nfv,nfqv,1);
9192: d = update_pairs(d,g,nh,0);
9193: g = update_base(g,nh);
9194: }
9195: if ( r || rm ) return 0;
9196: }
9197: conv_ilist(nd_demand,1,g,indp);
9198: return g;
9199: }
9200:
1.7 noro 9201: #if SIZEOF_LONG==8
9202:
9203: NDV vect64_to_ndv(mp_limb_t *vect,int spcol,int col,int *rhead,UINT *s0vect)
9204: {
9205: int j,k,len;
9206: UINT *p;
9207: UINT c;
9208: NDV r;
9209: NMV mr0,mr;
9210:
9211: for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++;
9212: if ( !len ) return 0;
9213: else {
9214: mr0 = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
9215: #if 0
9216: ndv_alloc += nmv_adv*len;
9217: #endif
9218: mr = mr0;
9219: p = s0vect;
9220: for ( j = k = 0; j < col; j++, p += nd_wpd )
9221: if ( !rhead[j] ) {
9222: if ( (c = (UINT)vect[k++]) != 0 ) {
9223: ndl_copy(p,DL(mr)); CM(mr) = c; NMV_ADV(mr);
9224: }
9225: }
9226: MKNDV(nd_nvar,mr0,len,r);
9227: return r;
9228: }
9229: }
9230:
9231: int nd_to_vect64(int mod,UINT *s0,int n,ND d,mp_limb_t *r)
9232: {
9233: NM m;
1.11 noro 9234: UINT *t,*s,*u;
9235: int i,st,ed,md,prev,c;
1.7 noro 9236:
9237: for ( i = 0; i < n; i++ ) r[i] = 0;
1.11 noro 9238: prev = 0;
9239: for ( i = 0, m = BDY(d); m; m = NEXT(m) ) {
9240: t = DL(m);
9241: st = prev;
9242: ed = n;
9243: while ( ed > st ) {
9244: md = (st+ed)/2;
9245: u = s0+md*nd_wpd;
9246: c = DL_COMPARE(u,t);
9247: if ( c == 0 ) break;
9248: else if ( c > 0 ) st = md;
9249: else ed = md;
9250: }
9251: r[md] = (mp_limb_t)CM(m);
9252: prev = md;
1.7 noro 9253: }
9254: for ( i = 0; !r[i]; i++ );
9255: return i;
9256: }
9257:
9258: #define MOD128(a,c,m) ((a)=(((c)!=0||((a)>=(m)))?(((((U128)(c))<<64)+(a))%(m)):(a)))
9259:
9260: int ndv_reduce_vect64(int m,mp_limb_t *svect,mp_limb_t *cvect,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
9261: {
9262: int i,j,k,len,pos,prev;
9263: mp_limb_t a,c,c1,c2;
9264: IndArray ivect;
9265: unsigned char *ivc;
9266: unsigned short *ivs;
9267: unsigned int *ivi;
9268: NDV redv;
9269: NMV mr;
9270: NODE rp;
9271: int maxrs;
9272:
9273: for ( i = 0; i < col; i++ ) cvect[i] = 0;
9274: maxrs = 0;
9275: for ( i = 0; i < nred; i++ ) {
9276: ivect = imat[i];
9277: k = ivect->head;
9278: a = svect[k]; c = cvect[k];
9279: MOD128(a,c,m);
9280: svect[k] = a; cvect[k] = 0;
9281: if ( (c = svect[k]) != 0 ) {
1.11 noro 9282: Nf4_red++;
1.7 noro 9283: maxrs = MAX(maxrs,rp0[i]->sugar);
9284: c = m-c; redv = nd_ps[rp0[i]->index];
9285: len = LEN(redv); mr = BDY(redv);
9286: svect[k] = 0; prev = k;
9287: switch ( ivect->width ) {
9288: case 1:
9289: ivc = ivect->index.c;
9290: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
9291: pos = prev+ivc[j]; c1 = CM(mr); prev = pos;
1.12 noro 9292: c2 = svect[pos]+c1*c;
9293: if ( c2 < svect[pos] ) cvect[pos]++;
9294: svect[pos] = c2;
1.7 noro 9295: }
9296: break;
9297: case 2:
9298: ivs = ivect->index.s;
9299: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
9300: pos = prev+ivs[j]; c1 = CM(mr); prev = pos;
1.12 noro 9301: c2 = svect[pos]+c1*c;
9302: if ( c2 < svect[pos] ) cvect[pos]++;
9303: svect[pos] = c2;
1.7 noro 9304: }
9305: break;
9306: case 4:
9307: ivi = ivect->index.i;
9308: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
9309: pos = prev+ivi[j]; c1 = CM(mr); prev = pos;
1.12 noro 9310: c2 = svect[pos]+c1*c;
9311: if ( c2 < svect[pos] ) cvect[pos]++;
9312: svect[pos] = c2;
1.7 noro 9313: }
9314: break;
9315: }
9316: }
9317: }
9318: for ( i = 0; i < col; i++ ) {
9319: a = svect[i]; c = cvect[i]; MOD128(a,c,m); svect[i] = a;
9320: }
9321: return maxrs;
9322: }
9323:
9324: /* for Fp, 2^15=<p<2^29 */
9325:
9326: NODE nd_f4_red_mod64_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
9327: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz)
9328: {
9329: int spcol,sprow,a;
9330: int i,j,k,l,rank;
9331: NODE r0,r;
9332: ND_pairs sp;
9333: ND spol;
9334: mp_limb_t **spmat;
9335: mp_limb_t *svect,*cvect;
9336: mp_limb_t *v;
9337: int *colstat;
9338: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
9339: int maxrs;
9340: int *spsugar;
9341: ND_pairs *spactive;
9342:
9343: spcol = col-nred;
9344: get_eg(&eg0);
9345: /* elimination (1st step) */
9346: spmat = (mp_limb_t **)MALLOC(nsp*sizeof(mp_limb_t *));
9347: svect = (mp_limb_t *)MALLOC(col*sizeof(mp_limb_t));
9348: cvect = (mp_limb_t *)MALLOC(col*sizeof(mp_limb_t));
9349: spsugar = (int *)MALLOC(nsp*sizeof(int));
9350: spactive = !nz?0:(ND_pairs *)MALLOC(nsp*sizeof(ND_pairs));
9351: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
9352: nd_sp(m,0,sp,&spol);
9353: if ( !spol ) continue;
9354: nd_to_vect64(m,s0vect,col,spol,svect);
9355: maxrs = ndv_reduce_vect64(m,svect,cvect,col,imat,rvect,nred);
9356: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
9357: if ( i < col ) {
9358: spmat[sprow] = v = (mp_limb_t *)MALLOC_ATOMIC(spcol*sizeof(mp_limb_t));
9359: for ( j = k = 0; j < col; j++ )
9360: if ( !rhead[j] ) v[k++] = (UINT)svect[j];
9361: spsugar[sprow] = MAX(maxrs,SG(spol));
9362: if ( nz )
9363: spactive[sprow] = sp;
9364: sprow++;
9365: }
9366: nd_free(spol);
9367: }
1.12 noro 9368: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1); add_eg(&f4_elim1,&eg0,&eg1);
1.7 noro 9369: if ( DP_Print ) {
9370: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
9371: fflush(asir_out);
9372: }
9373: /* free index arrays */
9374: for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c);
9375:
9376: /* elimination (2nd step) */
9377: colstat = (int *)MALLOC(spcol*sizeof(int));
9378: rank = nd_gauss_elim_mod64(spmat,spsugar,spactive,sprow,spcol,m,colstat);
9379: r0 = 0;
9380: for ( i = 0; i < rank; i++ ) {
9381: NEXTNODE(r0,r); BDY(r) =
9382: (pointer)vect64_to_ndv(spmat[i],spcol,col,rhead,s0vect);
9383: SG((NDV)BDY(r)) = spsugar[i];
9384: GCFREE(spmat[i]);
9385: }
9386: if ( r0 ) NEXT(r) = 0;
9387:
9388: for ( ; i < sprow; i++ ) GCFREE(spmat[i]);
1.12 noro 9389: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2); add_eg(&f4_elim2,&eg1,&eg2);
1.7 noro 9390: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
9391: if ( DP_Print ) {
9392: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
9393: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
9394: nsp,nred,sprow,spcol,rank);
9395: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
9396: }
9397: if ( nz ) {
9398: for ( i = 0; i < rank-1; i++ ) NEXT(spactive[i]) = spactive[i+1];
9399: if ( rank > 0 ) {
9400: NEXT(spactive[rank-1]) = 0;
9401: *nz = spactive[0];
9402: } else
9403: *nz = 0;
9404: }
9405: return r0;
9406: }
9407:
9408: int nd_gauss_elim_mod64(mp_limb_t **mat,int *sugar,ND_pairs *spactive,int row,int col,int md,int *colstat)
9409: {
9410: int i,j,k,l,rank,s;
9411: mp_limb_t inv;
9412: mp_limb_t a;
9413: UINT c;
9414: mp_limb_t *t,*pivot,*pk;
9415: UINT *ck;
9416: UINT **cmat;
9417: UINT *ct;
9418: ND_pairs pair;
9419:
9420: cmat = (UINT **)MALLOC(row*sizeof(UINT *));
9421: for ( i = 0; i < row; i++ ) {
9422: cmat[i] = MALLOC_ATOMIC(col*sizeof(UINT));
9423: bzero(cmat[i],col*sizeof(UINT));
9424: }
9425:
9426: for ( rank = 0, j = 0; j < col; j++ ) {
9427: for ( i = rank; i < row; i++ ) {
9428: a = mat[i][j]; c = cmat[i][j];
9429: MOD128(a,c,md);
9430: mat[i][j] = a; cmat[i][j] = 0;
9431: }
9432: for ( i = rank; i < row; i++ )
9433: if ( mat[i][j] )
9434: break;
9435: if ( i == row ) {
9436: colstat[j] = 0;
9437: continue;
9438: } else
9439: colstat[j] = 1;
9440: if ( i != rank ) {
9441: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
9442: ct = cmat[i]; cmat[i] = cmat[rank]; cmat[rank] = ct;
9443: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
9444: if ( spactive ) {
9445: pair = spactive[i]; spactive[i] = spactive[rank];
9446: spactive[rank] = pair;
9447: }
9448: }
9449: /* column j is normalized */
9450: s = sugar[rank];
9451: inv = invm((UINT)mat[rank][j],md);
9452: /* normalize pivot row */
9453: for ( k = j, pk = mat[rank]+j, ck = cmat[rank]+j; k < col; k++, pk++, ck++ ) {
9454: a = *pk; c = *ck; MOD128(a,c,md); *pk = (a*inv)%md; *ck = 0;
9455: }
9456: for ( i = rank+1; i < row; i++ ) {
9457: if ( (a = mat[i][j]) != 0 ) {
9458: sugar[i] = MAX(sugar[i],s);
9459: red_by_vect64(md,mat[i]+j,cmat[i]+j,mat[rank]+j,(int)(md-a),col-j);
1.11 noro 9460: Nf4_red++;
1.7 noro 9461: }
9462: }
9463: rank++;
9464: }
9465: for ( j = col-1, l = rank-1; j >= 0; j-- )
9466: if ( colstat[j] ) {
9467: for ( k = j, pk = mat[l]+j, ck = cmat[l]+j; k < col; k++, pk++, ck++ ) {
9468: a = *pk; c = *ck; MOD128(a,c,md); *pk = a; *ck = 0;
9469: }
9470: s = sugar[l];
9471: for ( i = 0; i < l; i++ ) {
9472: a = mat[i][j]; c = cmat[i][j]; MOD128(a,c,md); mat[i][j] = a; cmat[i][j] = 0;
9473: if ( a ) {
9474: sugar[i] = MAX(sugar[i],s);
9475: red_by_vect64(md,mat[i]+j,cmat[i]+j,mat[l]+j,(int)(md-a),col-j);
1.11 noro 9476: Nf4_red++;
1.7 noro 9477: }
9478: }
9479: l--;
9480: }
9481: for ( i = 0; i < row; i++ ) GCFREE(cmat[i]);
9482: GCFREE(cmat);
9483: return rank;
9484: }
9485: #endif
9486:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>