Annotation of OpenXM_contrib2/asir2018/engine/nd.c, Revision 1.29
1.29 ! noro 1: /* $OpenXM: OpenXM_contrib2/asir2018/engine/nd.c,v 1.28 2020/06/30 01:52:17 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.21 noro 11: /* for general module order */
1.19 noro 12: int (*ndl_base_compare_function)(UINT *a1,UINT *a2);
1.21 noro 13: int (*dl_base_compare_function)(int nv,DL a,DL b);
14: int nd_base_ordtype;
1.1 noro 15: int nd_dcomp;
16: int nd_rref2;
17: NM _nm_free_list;
18: ND _nd_free_list;
19: ND_pairs _ndp_free_list;
20: NODE nd_hcf;
1.26 noro 21: int Nsyz;
1.1 noro 22:
23: Obj nd_top_weight;
24:
25: static NODE nd_subst;
26: static VL nd_vc;
27: static int nd_ntrans;
28: static int nd_nalg;
29: #if 0
30: static int ndv_alloc;
31: #endif
32: #if 1
33: static int nd_f4_nsp=0x7fffffff;
34: #else
35: static int nd_f4_nsp=50;
36: #endif
37: static double nd_scale=2;
38: static UINT **nd_bound;
39: static struct order_spec *nd_ord;
40: static EPOS nd_epos;
41: static BlockMask nd_blockmask;
42: static int nd_nvar;
43: static int nd_isrlex;
44: static int nd_epw,nd_bpe,nd_wpd,nd_exporigin;
45: static UINT nd_mask[32];
46: static UINT nd_mask0,nd_mask1;
47:
48: static NDV *nd_ps;
49: static NDV *nd_ps_trace;
50: static NDV *nd_ps_sym;
51: static NDV *nd_ps_trace_sym;
52: static RHist *nd_psh;
53: static int nd_psn,nd_pslen;
54: static RHist *nd_red;
55: static int *nd_work_vector;
56: static int **nd_matrix;
57: static int nd_matrix_len;
58: static struct weight_or_block *nd_worb;
59: static int nd_worb_len;
60: static int nd_found,nd_create,nd_notfirst;
61: static int nmv_adv;
62: static int nd_demand;
1.21 noro 63: static int nd_module,nd_module_ordtype,nd_mpos,nd_pot_nelim;
1.1 noro 64: static int nd_module_rank,nd_poly_weight_len;
65: static int *nd_poly_weight,*nd_module_weight;
66: static NODE nd_tracelist;
67: static NODE nd_alltracelist;
68: static int nd_gentrace,nd_gensyz,nd_nora,nd_newelim,nd_intersect,nd_lf;
69: static int *nd_gbblock;
70: static NODE nd_nzlist,nd_check_splist;
71: static int nd_splist;
72: static int *nd_sugarweight;
73: static int nd_f4red,nd_rank0,nd_last_nonzero;
1.27 noro 74: static DL *nd_sba_hm;
1.29 ! noro 75: static NODE *nd_sba_pos;
1.1 noro 76:
77: NumberField get_numberfield();
78: UINT *nd_det_compute_bound(NDV **dm,int n,int j);
79: void nd_det_reconstruct(NDV **dm,int n,int j,NDV d);
80: void nd_heu_nezgcdnpz(VL vl,P *pl,int m,int full,P *pr);
81: int nd_monic(int m,ND *p);
82: NDV plain_vect_to_ndv_q(Z *mat,int col,UINT *s0vect);
83: LIST ndvtopl(int mod,VL vl,VL dvl,NDV p,int rank);
84: NDV pltondv(VL vl,VL dvl,LIST p);
85: void pltozpl(LIST l,Q *cont,LIST *pp);
86: void ndl_max(UINT *d1,unsigned *d2,UINT *d);
87: void nmtodp(int mod,NM m,DP *r);
1.15 noro 88: void ndltodp(UINT *d,DP *r);
1.1 noro 89: NODE reverse_node(NODE n);
90: P ndc_div(int mod,union oNDC a,union oNDC b);
91: P ndctop(int mod,union oNDC c);
92: void finalize_tracelist(int i,P cont);
93: void conv_ilist(int demand,int trace,NODE g,int **indp);
94: void parse_nd_option(NODE opt);
95: void dltondl(int n,DL dl,UINT *r);
96: DP ndvtodp(int mod,NDV p);
97: DP ndtodp(int mod,ND p);
1.16 noro 98: DPM ndvtodpm(int mod,NDV p);
99: NDV dpmtondv(int mod,DPM p);
100: int dpm_getdeg(DPM p,int *rank);
101: void dpm_ptozp(DPM p,Z *cont,DPM *r);
102: int compdmm(int nv,DMM a,DMM b);
1.1 noro 103:
104: void Pdp_set_weight(NODE,VECT *);
105: void Pox_cmo_rpc(NODE,Obj *);
106:
107: ND nd_add_lf(ND p1,ND p2);
108: void nd_mul_c_lf(ND p,Z mul);
109: void ndv_mul_c_lf(NDV p,Z mul);
110: NODE nd_f4_red_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
111: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz);
112: NODE nd_f4_red_mod64_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
113: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz);
114: NODE nd_f4_red_lf_main(int m,ND_pairs sp0,int nsp,int trace,UINT *s0vect,int col,
115: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred);
116: int nd_gauss_elim_lf(mpz_t **mat0,int *sugar,int row,int col,int *colstat);
117: NODE nd_f4_lf_trace_main(int m,int **indp);
118: void nd_f4_lf_trace(LIST f,LIST v,int trace,int homo,struct order_spec *ord,LIST *rp);
119:
120: extern int lf_lazy;
121: extern Z current_mod_lf;
122:
123: extern int Denominator,DP_Multiple,MaxDeg;
124:
125: #define BLEN (8*sizeof(unsigned long))
126:
127: typedef struct matrix {
128: int row,col;
129: unsigned long **a;
130: } *matrix;
131:
132:
133: void nd_free_private_storage()
134: {
135: _nm_free_list = 0;
136: _ndp_free_list = 0;
137: #if 0
138: GC_gcollect();
139: #endif
140: }
141:
142: void _NM_alloc()
143: {
144: NM p;
145: int i;
146:
147: for ( i = 0; i < 1024; i++ ) {
148: p = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
149: p->next = _nm_free_list; _nm_free_list = p;
150: }
151: }
152:
153: matrix alloc_matrix(int row,int col)
154: {
155: unsigned long **a;
156: int i,len,blen;
157: matrix mat;
158:
159: mat = (matrix)MALLOC(sizeof(struct matrix));
160: mat->row = row;
161: mat->col = col;
162: mat->a = a = (unsigned long **)MALLOC(row*sizeof(unsigned long *));
163: return mat;
164: }
165:
166:
167: void _ND_alloc()
168: {
169: ND p;
170: int i;
171:
172: for ( i = 0; i < 1024; i++ ) {
173: p = (ND)MALLOC(sizeof(struct oND));
174: p->body = (NM)_nd_free_list; _nd_free_list = p;
175: }
176: }
177:
178: void _NDP_alloc()
179: {
180: ND_pairs p;
181: int i;
182:
183: for ( i = 0; i < 1024; i++ ) {
184: p = (ND_pairs)MALLOC(sizeof(struct oND_pairs)
185: +(nd_wpd-1)*sizeof(UINT));
186: p->next = _ndp_free_list; _ndp_free_list = p;
187: }
188: }
189:
190: INLINE int nd_length(ND p)
191: {
192: NM m;
193: int i;
194:
195: if ( !p )
196: return 0;
197: else {
198: for ( i = 0, m = BDY(p); m; m = NEXT(m), i++ );
199: return i;
200: }
201: }
202:
203: extern int dp_negative_weight;
204:
205: INLINE int ndl_reducible(UINT *d1,UINT *d2)
206: {
207: UINT u1,u2;
208: int i,j;
209:
210: if ( nd_module && (MPOS(d1) != MPOS(d2)) ) return 0;
211:
212: if ( !dp_negative_weight && TD(d1) < TD(d2) ) return 0;
213: #if USE_UNROLL
214: switch ( nd_bpe ) {
215: case 3:
216: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
217: u1 = d1[i]; u2 = d2[i];
218: if ( (u1&0x38000000) < (u2&0x38000000) ) return 0;
219: if ( (u1& 0x7000000) < (u2& 0x7000000) ) return 0;
220: if ( (u1& 0xe00000) < (u2& 0xe00000) ) return 0;
221: if ( (u1& 0x1c0000) < (u2& 0x1c0000) ) return 0;
222: if ( (u1& 0x38000) < (u2& 0x38000) ) return 0;
223: if ( (u1& 0x7000) < (u2& 0x7000) ) return 0;
224: if ( (u1& 0xe00) < (u2& 0xe00) ) return 0;
225: if ( (u1& 0x1c0) < (u2& 0x1c0) ) return 0;
226: if ( (u1& 0x38) < (u2& 0x38) ) return 0;
227: if ( (u1& 0x7) < (u2& 0x7) ) return 0;
228: }
229: return 1;
230: break;
231: case 4:
232: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
233: u1 = d1[i]; u2 = d2[i];
234: if ( (u1&0xf0000000) < (u2&0xf0000000) ) return 0;
235: if ( (u1& 0xf000000) < (u2& 0xf000000) ) return 0;
236: if ( (u1& 0xf00000) < (u2& 0xf00000) ) return 0;
237: if ( (u1& 0xf0000) < (u2& 0xf0000) ) return 0;
238: if ( (u1& 0xf000) < (u2& 0xf000) ) return 0;
239: if ( (u1& 0xf00) < (u2& 0xf00) ) return 0;
240: if ( (u1& 0xf0) < (u2& 0xf0) ) return 0;
241: if ( (u1& 0xf) < (u2& 0xf) ) return 0;
242: }
243: return 1;
244: break;
245: case 6:
246: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
247: u1 = d1[i]; u2 = d2[i];
248: if ( (u1&0x3f000000) < (u2&0x3f000000) ) return 0;
249: if ( (u1& 0xfc0000) < (u2& 0xfc0000) ) return 0;
250: if ( (u1& 0x3f000) < (u2& 0x3f000) ) return 0;
251: if ( (u1& 0xfc0) < (u2& 0xfc0) ) return 0;
252: if ( (u1& 0x3f) < (u2& 0x3f) ) return 0;
253: }
254: return 1;
255: break;
256: case 8:
257: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
258: u1 = d1[i]; u2 = d2[i];
259: if ( (u1&0xff000000) < (u2&0xff000000) ) return 0;
260: if ( (u1& 0xff0000) < (u2& 0xff0000) ) return 0;
261: if ( (u1& 0xff00) < (u2& 0xff00) ) return 0;
262: if ( (u1& 0xff) < (u2& 0xff) ) return 0;
263: }
264: return 1;
265: break;
266: case 16:
267: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
268: u1 = d1[i]; u2 = d2[i];
269: if ( (u1&0xffff0000) < (u2&0xffff0000) ) return 0;
270: if ( (u1& 0xffff) < (u2& 0xffff) ) return 0;
271: }
272: return 1;
273: break;
274: case 32:
275: for ( i = nd_exporigin; i < nd_wpd; i++ )
276: if ( d1[i] < d2[i] ) return 0;
277: return 1;
278: break;
279: default:
280: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
281: u1 = d1[i]; u2 = d2[i];
282: for ( j = 0; j < nd_epw; j++ )
283: if ( (u1&nd_mask[j]) < (u2&nd_mask[j]) ) return 0;
284: }
285: return 1;
286: }
287: #else
288: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
289: u1 = d1[i]; u2 = d2[i];
290: for ( j = 0; j < nd_epw; j++ )
291: if ( (u1&nd_mask[j]) < (u2&nd_mask[j]) ) return 0;
292: }
293: return 1;
294: #endif
295: }
296:
297: /*
298: * If the current order is a block order,
299: * then the last block is length 1 and contains
300: * the homo variable. Otherwise, the original
301: * order is either 0 or 2.
302: */
303:
304: void ndl_homogenize(UINT *d,UINT *r,int obpe,EPOS oepos,int ompos,int weight)
305: {
306: int w,i,e,n,omask0;
307:
308: omask0 = obpe==32?0xffffffff:((1<<obpe)-1);
309: n = nd_nvar-1;
310: ndl_zero(r);
311: for ( i = 0; i < n; i++ ) {
312: e = GET_EXP_OLD(d,i);
313: PUT_EXP(r,i,e);
314: }
315: w = TD(d);
316: PUT_EXP(r,nd_nvar-1,weight-w);
317: if ( nd_module ) MPOS(r) = d[ompos];
318: TD(r) = weight;
319: if ( nd_blockmask ) ndl_weight_mask(r);
320: }
321:
322: void ndl_dehomogenize(UINT *d)
323: {
324: UINT mask;
325: UINT h;
326: int i,bits;
327:
328: if ( nd_blockmask ) {
329: h = GET_EXP(d,nd_nvar-1);
330: XOR_EXP(d,nd_nvar-1,h);
331: TD(d) -= h;
332: ndl_weight_mask(d);
333: } else {
334: if ( nd_isrlex ) {
335: if ( nd_bpe == 32 ) {
336: h = d[nd_exporigin];
337: for ( i = nd_exporigin+1; i < nd_wpd; i++ )
338: d[i-1] = d[i];
339: d[i-1] = 0;
340: TD(d) -= h;
341: } else {
342: bits = nd_epw*nd_bpe;
343: mask = bits==32?0xffffffff:((1<<(nd_epw*nd_bpe))-1);
344: h = (d[nd_exporigin]>>((nd_epw-1)*nd_bpe))&nd_mask0;
345: for ( i = nd_exporigin; i < nd_wpd; i++ )
346: d[i] = ((d[i]<<nd_bpe)&mask)
347: |(i+1<nd_wpd?((d[i+1]>>((nd_epw-1)*nd_bpe))&nd_mask0):0);
348: TD(d) -= h;
349: }
350: } else {
351: h = GET_EXP(d,nd_nvar-1);
352: XOR_EXP(d,nd_nvar-1,h);
353: TD(d) -= h;
354: }
355: }
356: }
357:
358: void ndl_lcm(UINT *d1,unsigned *d2,UINT *d)
359: {
360: UINT t1,t2,u,u1,u2;
361: int i,j,l;
362:
363: if ( nd_module && (MPOS(d1) != MPOS(d2)) )
364: error("ndl_lcm : inconsistent monomials");
365: #if USE_UNROLL
366: switch ( nd_bpe ) {
367: case 3:
368: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
369: u1 = d1[i]; u2 = d2[i];
370: t1 = (u1&0x38000000); t2 = (u2&0x38000000); u = t1>t2?t1:t2;
371: t1 = (u1& 0x7000000); t2 = (u2& 0x7000000); u |= t1>t2?t1:t2;
372: t1 = (u1& 0xe00000); t2 = (u2& 0xe00000); u |= t1>t2?t1:t2;
373: t1 = (u1& 0x1c0000); t2 = (u2& 0x1c0000); u |= t1>t2?t1:t2;
374: t1 = (u1& 0x38000); t2 = (u2& 0x38000); u |= t1>t2?t1:t2;
375: t1 = (u1& 0x7000); t2 = (u2& 0x7000); u |= t1>t2?t1:t2;
376: t1 = (u1& 0xe00); t2 = (u2& 0xe00); u |= t1>t2?t1:t2;
377: t1 = (u1& 0x1c0); t2 = (u2& 0x1c0); u |= t1>t2?t1:t2;
378: t1 = (u1& 0x38); t2 = (u2& 0x38); u |= t1>t2?t1:t2;
379: t1 = (u1& 0x7); t2 = (u2& 0x7); u |= t1>t2?t1:t2;
380: d[i] = u;
381: }
382: break;
383: case 4:
384: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
385: u1 = d1[i]; u2 = d2[i];
386: t1 = (u1&0xf0000000); t2 = (u2&0xf0000000); u = t1>t2?t1:t2;
387: t1 = (u1& 0xf000000); t2 = (u2& 0xf000000); u |= t1>t2?t1:t2;
388: t1 = (u1& 0xf00000); t2 = (u2& 0xf00000); u |= t1>t2?t1:t2;
389: t1 = (u1& 0xf0000); t2 = (u2& 0xf0000); u |= t1>t2?t1:t2;
390: t1 = (u1& 0xf000); t2 = (u2& 0xf000); u |= t1>t2?t1:t2;
391: t1 = (u1& 0xf00); t2 = (u2& 0xf00); u |= t1>t2?t1:t2;
392: t1 = (u1& 0xf0); t2 = (u2& 0xf0); u |= t1>t2?t1:t2;
393: t1 = (u1& 0xf); t2 = (u2& 0xf); u |= t1>t2?t1:t2;
394: d[i] = u;
395: }
396: break;
397: case 6:
398: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
399: u1 = d1[i]; u2 = d2[i];
400: t1 = (u1&0x3f000000); t2 = (u2&0x3f000000); u = t1>t2?t1:t2;
401: t1 = (u1& 0xfc0000); t2 = (u2& 0xfc0000); u |= t1>t2?t1:t2;
402: t1 = (u1& 0x3f000); t2 = (u2& 0x3f000); u |= t1>t2?t1:t2;
403: t1 = (u1& 0xfc0); t2 = (u2& 0xfc0); u |= t1>t2?t1:t2;
404: t1 = (u1& 0x3f); t2 = (u2& 0x3f); u |= t1>t2?t1:t2;
405: d[i] = u;
406: }
407: break;
408: case 8:
409: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
410: u1 = d1[i]; u2 = d2[i];
411: t1 = (u1&0xff000000); t2 = (u2&0xff000000); u = t1>t2?t1:t2;
412: t1 = (u1& 0xff0000); t2 = (u2& 0xff0000); u |= t1>t2?t1:t2;
413: t1 = (u1& 0xff00); t2 = (u2& 0xff00); u |= t1>t2?t1:t2;
414: t1 = (u1& 0xff); t2 = (u2& 0xff); u |= t1>t2?t1:t2;
415: d[i] = u;
416: }
417: break;
418: case 16:
419: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
420: u1 = d1[i]; u2 = d2[i];
421: t1 = (u1&0xffff0000); t2 = (u2&0xffff0000); u = t1>t2?t1:t2;
422: t1 = (u1& 0xffff); t2 = (u2& 0xffff); u |= t1>t2?t1:t2;
423: d[i] = u;
424: }
425: break;
426: case 32:
427: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
428: u1 = d1[i]; u2 = d2[i];
429: d[i] = u1>u2?u1:u2;
430: }
431: break;
432: default:
433: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
434: u1 = d1[i]; u2 = d2[i];
435: for ( j = 0, u = 0; j < nd_epw; j++ ) {
436: t1 = (u1&nd_mask[j]); t2 = (u2&nd_mask[j]); u |= t1>t2?t1:t2;
437: }
438: d[i] = u;
439: }
440: break;
441: }
442: #else
443: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
444: u1 = d1[i]; u2 = d2[i];
445: for ( j = 0, u = 0; j < nd_epw; j++ ) {
446: t1 = (u1&nd_mask[j]); t2 = (u2&nd_mask[j]); u |= t1>t2?t1:t2;
447: }
448: d[i] = u;
449: }
450: #endif
451: if ( nd_module ) MPOS(d) = MPOS(d1);
452: TD(d) = ndl_weight(d);
453: if ( nd_blockmask ) ndl_weight_mask(d);
454: }
455:
456: void ndl_max(UINT *d1,unsigned *d2,UINT *d)
457: {
458: UINT t1,t2,u,u1,u2;
459: int i,j,l;
460:
461: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
462: u1 = d1[i]; u2 = d2[i];
463: for ( j = 0, u = 0; j < nd_epw; j++ ) {
464: t1 = (u1&nd_mask[j]); t2 = (u2&nd_mask[j]); u |= t1>t2?t1:t2;
465: }
466: d[i] = u;
467: }
468: }
469:
470: int ndl_weight(UINT *d)
471: {
472: UINT t,u;
473: int i,j;
474:
475: if ( current_dl_weight_vector )
476: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
477: u = GET_EXP(d,i);
478: t += MUL_WEIGHT(u,i);
479: }
480: else
481: for ( t = 0, i = nd_exporigin; i < nd_wpd; i++ ) {
482: u = d[i];
483: for ( j = 0; j < nd_epw; j++, u>>=nd_bpe )
484: t += (u&nd_mask0);
485: }
1.20 noro 486: if ( nd_module && nd_module_rank && MPOS(d) )
487: t += nd_module_weight[MPOS(d)-1];
488: for ( i = nd_exporigin; i < nd_wpd; i++ )
489: if ( d[i] && !t )
490: printf("afo\n");
1.1 noro 491: return t;
492: }
493:
494: /* for sugarweight */
495:
496: int ndl_weight2(UINT *d)
497: {
498: int t,u;
499: int i,j;
500:
501: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
502: u = GET_EXP(d,i);
503: t += nd_sugarweight[i]*u;
504: }
1.20 noro 505: if ( nd_module && nd_module_rank && MPOS(d) )
506: t += nd_module_weight[MPOS(d)-1];
1.1 noro 507: return t;
508: }
509:
510: void ndl_weight_mask(UINT *d)
511: {
512: UINT t,u;
513: UINT *mask;
514: int i,j,k,l;
515:
516: l = nd_blockmask->n;
517: for ( k = 0; k < l; k++ ) {
518: mask = nd_blockmask->mask[k];
519: if ( current_dl_weight_vector )
520: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
521: u = GET_EXP_MASK(d,i,mask);
522: t += MUL_WEIGHT(u,i);
523: }
524: else
525: for ( t = 0, i = nd_exporigin; i < nd_wpd; i++ ) {
526: u = d[i]&mask[i];
527: for ( j = 0; j < nd_epw; j++, u>>=nd_bpe )
528: t += (u&nd_mask0);
529: }
530: d[k+1] = t;
531: }
532: }
533:
1.21 noro 534: int ndl_glex_compare(UINT *d1,UINT *d2)
535: {
536: if ( TD(d1) > TD(d2) ) return 1;
537: else if ( TD(d1) < TD(d2) ) return -1;
538: else return ndl_lex_compare(d1,d2);
539: }
540:
1.1 noro 541: int ndl_lex_compare(UINT *d1,UINT *d2)
542: {
543: int i;
544:
545: d1 += nd_exporigin;
546: d2 += nd_exporigin;
547: for ( i = nd_exporigin; i < nd_wpd; i++, d1++, d2++ )
548: if ( *d1 > *d2 )
549: return nd_isrlex ? -1 : 1;
550: else if ( *d1 < *d2 )
551: return nd_isrlex ? 1 : -1;
552: return 0;
553: }
554:
555: int ndl_block_compare(UINT *d1,UINT *d2)
556: {
557: int i,l,j,ord_o,ord_l;
558: struct order_pair *op;
559: UINT t1,t2,m;
560: UINT *mask;
561:
562: l = nd_blockmask->n;
563: op = nd_blockmask->order_pair;
564: for ( j = 0; j < l; j++ ) {
565: mask = nd_blockmask->mask[j];
566: ord_o = op[j].order;
567: if ( ord_o < 2 ) {
568: if ( (t1=d1[j+1]) > (t2=d2[j+1]) ) return 1;
569: else if ( t1 < t2 ) return -1;
570: }
571: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
572: m = mask[i];
573: t1 = d1[i]&m;
574: t2 = d2[i]&m;
575: if ( t1 > t2 )
576: return !ord_o ? -1 : 1;
577: else if ( t1 < t2 )
578: return !ord_o ? 1 : -1;
579: }
580: }
581: return 0;
582: }
583:
584: int ndl_matrix_compare(UINT *d1,UINT *d2)
585: {
586: int i,j,s,row;
587: int *v;
588: Z **mat;
589: Z *w;
590: Z t1;
591: Z t,t2;
592:
1.6 noro 593: for ( j = 0; j < nd_nvar; j++ )
594: nd_work_vector[j] = GET_EXP(d1,j)-GET_EXP(d2,j);
1.1 noro 595: if ( nd_top_weight ) {
596: if ( OID(nd_top_weight) == O_VECT ) {
1.6 noro 597: mat = (Z **)&BDY((VECT)nd_top_weight);
598: row = 1;
1.1 noro 599: } else {
600: mat = (Z **)BDY((MAT)nd_top_weight);
1.6 noro 601: row = ((MAT)nd_top_weight)->row;
1.1 noro 602: }
603: for ( i = 0; i < row; i++ ) {
1.6 noro 604: w = mat[i];
1.1 noro 605: for ( j = 0, t = 0; j < nd_nvar; j++ ) {
1.6 noro 606: STOZ(nd_work_vector[j],t1);
1.1 noro 607: mulz(w[j],t1,&t2);
608: addz(t,t2,&t1);
609: t = t1;
610: }
1.6 noro 611: if ( t ) {
612: s = sgnz(t);
1.1 noro 613: if ( s > 0 ) return 1;
614: else if ( s < 0 ) return -1;
1.6 noro 615: }
1.1 noro 616: }
1.6 noro 617: }
618: for ( i = 0; i < nd_matrix_len; i++ ) {
619: v = nd_matrix[i];
620: for ( j = 0, s = 0; j < nd_nvar; j++ )
621: s += v[j]*nd_work_vector[j];
622: if ( s > 0 ) return 1;
623: else if ( s < 0 ) return -1;
624: }
1.1 noro 625: if ( !ndl_equal(d1,d2) )
1.6 noro 626: error("ndl_matrix_compare : invalid matrix");
627: return 0;
1.1 noro 628: }
629:
630: int ndl_composite_compare(UINT *d1,UINT *d2)
631: {
632: int i,j,s,start,end,len,o;
633: int *v;
634: struct sparse_weight *sw;
635:
636: for ( j = 0; j < nd_nvar; j++ )
637: nd_work_vector[j] = GET_EXP(d1,j)-GET_EXP(d2,j);
638: for ( i = 0; i < nd_worb_len; i++ ) {
639: len = nd_worb[i].length;
640: switch ( nd_worb[i].type ) {
641: case IS_DENSE_WEIGHT:
642: v = nd_worb[i].body.dense_weight;
643: for ( j = 0, s = 0; j < len; j++ )
644: s += v[j]*nd_work_vector[j];
645: if ( s > 0 ) return 1;
646: else if ( s < 0 ) return -1;
647: break;
648: case IS_SPARSE_WEIGHT:
649: sw = nd_worb[i].body.sparse_weight;
650: for ( j = 0, s = 0; j < len; j++ )
651: s += sw[j].value*nd_work_vector[sw[j].pos];
652: if ( s > 0 ) return 1;
653: else if ( s < 0 ) return -1;
654: break;
655: case IS_BLOCK:
656: o = nd_worb[i].body.block.order;
657: start = nd_worb[i].body.block.start;
658: switch ( o ) {
659: case 0:
660: end = start+len;
661: for ( j = start, s = 0; j < end; j++ )
662: s += MUL_WEIGHT(nd_work_vector[j],j);
663: if ( s > 0 ) return 1;
664: else if ( s < 0 ) return -1;
665: for ( j = end-1; j >= start; j-- )
666: if ( nd_work_vector[j] < 0 ) return 1;
667: else if ( nd_work_vector[j] > 0 ) return -1;
668: break;
669: case 1:
670: end = start+len;
671: for ( j = start, s = 0; j < end; j++ )
672: s += MUL_WEIGHT(nd_work_vector[j],j);
673: if ( s > 0 ) return 1;
674: else if ( s < 0 ) return -1;
675: for ( j = start; j < end; j++ )
676: if ( nd_work_vector[j] > 0 ) return 1;
677: else if ( nd_work_vector[j] < 0 ) return -1;
678: break;
679: case 2:
680: end = start+len;
681: for ( j = start; j < end; j++ )
682: if ( nd_work_vector[j] > 0 ) return 1;
683: else if ( nd_work_vector[j] < 0 ) return -1;
684: break;
685: }
686: break;
687: }
688: }
689: return 0;
690: }
691:
692: /* TDH -> WW -> TD-> RL */
693:
694: int ndl_ww_lex_compare(UINT *d1,UINT *d2)
695: {
696: int i,m,e1,e2;
697:
698: if ( TD(d1) > TD(d2) ) return 1;
699: else if ( TD(d1) < TD(d2) ) return -1;
700: m = nd_nvar>>1;
701: for ( i = 0, e1 = e2 = 0; i < m; i++ ) {
702: e1 += current_weyl_weight_vector[i]*(GET_EXP(d1,m+i)-GET_EXP(d1,i));
703: e2 += current_weyl_weight_vector[i]*(GET_EXP(d2,m+i)-GET_EXP(d2,i));
704: }
705: if ( e1 > e2 ) return 1;
706: else if ( e1 < e2 ) return -1;
707: return ndl_lex_compare(d1,d2);
708: }
709:
1.21 noro 710: // common function for module glex and grlex comparison
711: int ndl_module_glex_compare(UINT *d1,UINT *d2)
1.1 noro 712: {
1.21 noro 713: int c;
1.1 noro 714:
1.21 noro 715: switch ( nd_module_ordtype ) {
716: case 0:
717: if ( TD(d1) > TD(d2) ) return 1;
718: else if ( TD(d1) < TD(d2) ) return -1;
719: else if ( (c = ndl_lex_compare(d1,d2)) != 0 ) return c;
720: else if ( MPOS(d1) < MPOS(d2) ) return 1;
721: else if ( MPOS(d1) > MPOS(d2) ) return -1;
722: else return 0;
723: break;
1.1 noro 724:
1.21 noro 725: case 1:
1.19 noro 726: if ( nd_pot_nelim && MPOS(d1)>=nd_pot_nelim+1 && MPOS(d2) >= nd_pot_nelim+1 ) {
727: if ( TD(d1) > TD(d2) ) return 1;
728: else if ( TD(d1) < TD(d2) ) return -1;
729: if ( (c = ndl_lex_compare(d1,d2)) != 0 ) return c;
730: if ( MPOS(d1) < MPOS(d2) ) return 1;
731: else if ( MPOS(d1) > MPOS(d2) ) return -1;
732: }
733: if ( MPOS(d1) < MPOS(d2) ) return 1;
734: else if ( MPOS(d1) > MPOS(d2) ) return -1;
1.21 noro 735: else if ( TD(d1) > TD(d2) ) return 1;
736: else if ( TD(d1) < TD(d2) ) return -1;
737: else return ndl_lex_compare(d1,d2);
738: break;
1.1 noro 739:
1.21 noro 740: case 2: // weight -> POT
741: if ( TD(d1) > TD(d2) ) return 1;
742: else if ( TD(d1) < TD(d2) ) return -1;
743: else if ( MPOS(d1) < MPOS(d2) ) return 1;
744: else if ( MPOS(d1) > MPOS(d2) ) return -1;
745: else return ndl_lex_compare(d1,d2);
746: break;
1.1 noro 747:
1.21 noro 748: default:
749: error("ndl_module_glex_compare : invalid module_ordtype");
1.28 noro 750: return 0;
1.21 noro 751: }
1.1 noro 752: }
753:
1.21 noro 754: // common for module comparison
755: int ndl_module_compare(UINT *d1,UINT *d2)
1.1 noro 756: {
1.21 noro 757: int c;
1.1 noro 758:
1.21 noro 759: switch ( nd_module_ordtype ) {
760: case 0:
1.23 noro 761: if ( (c = (*ndl_base_compare_function)(d1,d2)) != 0 ) return c;
1.21 noro 762: else if ( MPOS(d1) > MPOS(d2) ) return -1;
763: else if ( MPOS(d1) < MPOS(d2) ) return 1;
764: else return 0;
765: break;
1.1 noro 766:
1.21 noro 767: case 1:
768: if ( MPOS(d1) < MPOS(d2) ) return 1;
769: else if ( MPOS(d1) > MPOS(d2) ) return -1;
770: else return (*ndl_base_compare_function)(d1,d2);
771: break;
1.1 noro 772:
1.21 noro 773: case 2: // weight -> POT
774: if ( TD(d1) > TD(d2) ) return 1;
775: else if ( TD(d1) < TD(d2) ) return -1;
776: else if ( MPOS(d1) < MPOS(d2) ) return 1;
777: else if ( MPOS(d1) > MPOS(d2) ) return -1;
778: else return (*ndl_base_compare_function)(d1,d2);
779: break;
1.1 noro 780:
1.21 noro 781: default:
782: error("ndl_module_compare : invalid module_ordtype");
1.28 noro 783: return 0;
1.21 noro 784: }
1.1 noro 785: }
786:
1.21 noro 787: extern DMMstack dmm_stack;
788: void _addtodl(int n,DL d1,DL d2);
789: int _eqdl(int n,DL d1,DL d2);
790:
791: int ndl_module_schreyer_compare(UINT *m1,UINT *m2)
792: {
793: int pos1,pos2,t,j;
794: DMM *in;
795: DMMstack s;
796: static DL d1=0;
797: static DL d2=0;
798: static int dlen=0;
799:
800: pos1 = MPOS(m1); pos2 = MPOS(m2);
801: if ( pos1 == pos2 ) return (*ndl_base_compare_function)(m1,m2);
802: if ( nd_nvar > dlen ) {
803: NEWDL(d1,nd_nvar);
804: NEWDL(d2,nd_nvar);
805: dlen = nd_nvar;
806: }
807: d1->td = TD(m1);
808: for ( j = 0; j < nd_nvar; j++ ) d1->d[j] = GET_EXP(m1,j);
809: d2->td = TD(m2);
810: for ( j = 0; j < nd_nvar; j++ ) d2->d[j] = GET_EXP(m2,j);
811: for ( s = dmm_stack; s; s = NEXT(s) ) {
812: in = s->in;
813: _addtodl(nd_nvar,in[pos1]->dl,d1);
814: _addtodl(nd_nvar,in[pos2]->dl,d2);
815: if ( in[pos1]->pos == in[pos2]->pos && _eqdl(nd_nvar,d1,d2)) {
816: if ( pos1 < pos2 ) return 1;
817: else if ( pos1 > pos2 ) return -1;
818: else return 0;
819: }
820: pos1 = in[pos1]->pos;
821: pos2 = in[pos2]->pos;
822: if ( pos1 == pos2 ) return (*dl_base_compare_function)(nd_nvar,d1,d2);
823: }
824: // comparison by the bottom order
825: LAST:
826: switch ( nd_base_ordtype ) {
827: case 0:
828: t = (*dl_base_compare_function)(nd_nvar,d1,d2);
829: if ( t ) return t;
830: else if ( pos1 < pos2 ) return 1;
831: else if ( pos1 > pos2 ) return -1;
832: else return 0;
833: break;
834: case 1:
835: if ( pos1 < pos2 ) return 1;
836: else if ( pos1 > pos2 ) return -1;
837: else return (*dl_base_compare_function)(nd_nvar,d1,d2);
838: break;
839: case 2:
840: if ( d1->td > d2->td ) return 1;
841: else if ( d1->td < d2->td ) return -1;
842: else if ( pos1 < pos2 ) return 1;
843: else if ( pos1 > pos2 ) return -1;
844: else return (*dl_base_compare_function)(nd_nvar,d1,d2);
845: break;
846: default:
847: error("ndl_schreyer_compare : invalid base ordtype");
1.28 noro 848: return 0;
1.21 noro 849: }
1.1 noro 850: }
851:
852: INLINE int ndl_equal(UINT *d1,UINT *d2)
853: {
854: int i;
855:
856: switch ( nd_wpd ) {
857: case 2:
858: if ( TD(d2) != TD(d1) ) return 0;
859: if ( d2[1] != d1[1] ) return 0;
860: return 1;
861: break;
862: case 3:
863: if ( TD(d2) != TD(d1) ) return 0;
864: if ( d2[1] != d1[1] ) return 0;
865: if ( d2[2] != d1[2] ) return 0;
866: return 1;
867: break;
868: default:
869: for ( i = 0; i < nd_wpd; i++ )
870: if ( *d1++ != *d2++ ) return 0;
871: return 1;
872: break;
873: }
874: }
875:
876: INLINE void ndl_copy(UINT *d1,UINT *d2)
877: {
878: int i;
879:
880: switch ( nd_wpd ) {
881: case 2:
882: TD(d2) = TD(d1);
883: d2[1] = d1[1];
884: break;
885: case 3:
886: TD(d2) = TD(d1);
887: d2[1] = d1[1];
888: d2[2] = d1[2];
889: break;
890: default:
891: for ( i = 0; i < nd_wpd; i++ )
892: d2[i] = d1[i];
893: break;
894: }
895: }
896:
897: INLINE void ndl_zero(UINT *d)
898: {
899: int i;
900: for ( i = 0; i < nd_wpd; i++ ) d[i] = 0;
901: }
902:
903: INLINE void ndl_add(UINT *d1,UINT *d2,UINT *d)
904: {
905: int i;
906:
907: if ( nd_module ) {
908: if ( MPOS(d1) && MPOS(d2) && (MPOS(d1) != MPOS(d2)) )
909: error("ndl_add : invalid operation");
910: }
911: #if 1
912: switch ( nd_wpd ) {
913: case 2:
914: TD(d) = TD(d1)+TD(d2);
915: d[1] = d1[1]+d2[1];
916: break;
917: case 3:
918: TD(d) = TD(d1)+TD(d2);
919: d[1] = d1[1]+d2[1];
920: d[2] = d1[2]+d2[2];
921: break;
922: default:
923: for ( i = 0; i < nd_wpd; i++ ) d[i] = d1[i]+d2[i];
924: break;
925: }
926: #else
927: for ( i = 0; i < nd_wpd; i++ ) d[i] = d1[i]+d2[i];
928: #endif
929: }
930:
931: /* d1 += d2 */
932: INLINE void ndl_addto(UINT *d1,UINT *d2)
933: {
934: int i;
935:
936: if ( nd_module ) {
937: if ( MPOS(d1) && MPOS(d2) && (MPOS(d1) != MPOS(d2)) )
938: error("ndl_addto : invalid operation");
939: }
940: #if 1
941: switch ( nd_wpd ) {
942: case 2:
943: TD(d1) += TD(d2);
944: d1[1] += d2[1];
945: break;
946: case 3:
947: TD(d1) += TD(d2);
948: d1[1] += d2[1];
949: d1[2] += d2[2];
950: break;
951: default:
952: for ( i = 0; i < nd_wpd; i++ ) d1[i] += d2[i];
953: break;
954: }
955: #else
956: for ( i = 0; i < nd_wpd; i++ ) d1[i] += d2[i];
957: #endif
958: }
959:
960: INLINE void ndl_sub(UINT *d1,UINT *d2,UINT *d)
961: {
962: int i;
963:
964: for ( i = 0; i < nd_wpd; i++ ) d[i] = d1[i]-d2[i];
965: }
966:
967: int ndl_disjoint(UINT *d1,UINT *d2)
968: {
969: UINT t1,t2,u,u1,u2;
970: int i,j;
971:
972: if ( nd_module && (MPOS(d1) == MPOS(d2)) ) return 0;
973: #if USE_UNROLL
974: switch ( nd_bpe ) {
975: case 3:
976: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
977: u1 = d1[i]; u2 = d2[i];
978: t1 = u1&0x38000000; t2 = u2&0x38000000; if ( t1&&t2 ) return 0;
979: t1 = u1& 0x7000000; t2 = u2& 0x7000000; if ( t1&&t2 ) return 0;
980: t1 = u1& 0xe00000; t2 = u2& 0xe00000; if ( t1&&t2 ) return 0;
981: t1 = u1& 0x1c0000; t2 = u2& 0x1c0000; if ( t1&&t2 ) return 0;
982: t1 = u1& 0x38000; t2 = u2& 0x38000; if ( t1&&t2 ) return 0;
983: t1 = u1& 0x7000; t2 = u2& 0x7000; if ( t1&&t2 ) return 0;
984: t1 = u1& 0xe00; t2 = u2& 0xe00; if ( t1&&t2 ) return 0;
985: t1 = u1& 0x1c0; t2 = u2& 0x1c0; if ( t1&&t2 ) return 0;
986: t1 = u1& 0x38; t2 = u2& 0x38; if ( t1&&t2 ) return 0;
987: t1 = u1& 0x7; t2 = u2& 0x7; if ( t1&&t2 ) return 0;
988: }
989: return 1;
990: break;
991: case 4:
992: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
993: u1 = d1[i]; u2 = d2[i];
994: t1 = u1&0xf0000000; t2 = u2&0xf0000000; if ( t1&&t2 ) return 0;
995: t1 = u1& 0xf000000; t2 = u2& 0xf000000; if ( t1&&t2 ) return 0;
996: t1 = u1& 0xf00000; t2 = u2& 0xf00000; if ( t1&&t2 ) return 0;
997: t1 = u1& 0xf0000; t2 = u2& 0xf0000; if ( t1&&t2 ) return 0;
998: t1 = u1& 0xf000; t2 = u2& 0xf000; if ( t1&&t2 ) return 0;
999: t1 = u1& 0xf00; t2 = u2& 0xf00; if ( t1&&t2 ) return 0;
1000: t1 = u1& 0xf0; t2 = u2& 0xf0; if ( t1&&t2 ) return 0;
1001: t1 = u1& 0xf; t2 = u2& 0xf; if ( t1&&t2 ) return 0;
1002: }
1003: return 1;
1004: break;
1005: case 6:
1006: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1007: u1 = d1[i]; u2 = d2[i];
1008: t1 = u1&0x3f000000; t2 = u2&0x3f000000; if ( t1&&t2 ) return 0;
1009: t1 = u1& 0xfc0000; t2 = u2& 0xfc0000; if ( t1&&t2 ) return 0;
1010: t1 = u1& 0x3f000; t2 = u2& 0x3f000; if ( t1&&t2 ) return 0;
1011: t1 = u1& 0xfc0; t2 = u2& 0xfc0; if ( t1&&t2 ) return 0;
1012: t1 = u1& 0x3f; t2 = u2& 0x3f; if ( t1&&t2 ) return 0;
1013: }
1014: return 1;
1015: break;
1016: case 8:
1017: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1018: u1 = d1[i]; u2 = d2[i];
1019: t1 = u1&0xff000000; t2 = u2&0xff000000; if ( t1&&t2 ) return 0;
1020: t1 = u1& 0xff0000; t2 = u2& 0xff0000; if ( t1&&t2 ) return 0;
1021: t1 = u1& 0xff00; t2 = u2& 0xff00; if ( t1&&t2 ) return 0;
1022: t1 = u1& 0xff; t2 = u2& 0xff; if ( t1&&t2 ) return 0;
1023: }
1024: return 1;
1025: break;
1026: case 16:
1027: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1028: u1 = d1[i]; u2 = d2[i];
1029: t1 = u1&0xffff0000; t2 = u2&0xffff0000; if ( t1&&t2 ) return 0;
1030: t1 = u1& 0xffff; t2 = u2& 0xffff; if ( t1&&t2 ) return 0;
1031: }
1032: return 1;
1033: break;
1034: case 32:
1035: for ( i = nd_exporigin; i < nd_wpd; i++ )
1036: if ( d1[i] && d2[i] ) return 0;
1037: return 1;
1038: break;
1039: default:
1040: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1041: u1 = d1[i]; u2 = d2[i];
1042: for ( j = 0; j < nd_epw; j++ ) {
1043: if ( (u1&nd_mask0) && (u2&nd_mask0) ) return 0;
1044: u1 >>= nd_bpe; u2 >>= nd_bpe;
1045: }
1046: }
1047: return 1;
1048: break;
1049: }
1050: #else
1051: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1052: u1 = d1[i]; u2 = d2[i];
1053: for ( j = 0; j < nd_epw; j++ ) {
1054: if ( (u1&nd_mask0) && (u2&nd_mask0) ) return 0;
1055: u1 >>= nd_bpe; u2 >>= nd_bpe;
1056: }
1057: }
1058: return 1;
1059: #endif
1060: }
1061:
1062: int ndl_check_bound(UINT *d1,UINT *d2)
1063: {
1064: UINT u2;
1065: int i,j,ind,k;
1066:
1067: ind = 0;
1068: #if USE_UNROLL
1069: switch ( nd_bpe ) {
1070: case 3:
1071: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1072: u2 = d2[i];
1073: if ( d1[ind++]+((u2>>27)&0x7) >= 0x8 ) return 1;
1074: if ( d1[ind++]+((u2>>24)&0x7) >= 0x8 ) return 1;
1075: if ( d1[ind++]+((u2>>21)&0x7) >= 0x8 ) return 1;
1076: if ( d1[ind++]+((u2>>18)&0x7) >= 0x8 ) return 1;
1077: if ( d1[ind++]+((u2>>15)&0x7) >= 0x8 ) return 1;
1078: if ( d1[ind++]+((u2>>12)&0x7) >= 0x8 ) return 1;
1079: if ( d1[ind++]+((u2>>9)&0x7) >= 0x8 ) return 1;
1080: if ( d1[ind++]+((u2>>6)&0x7) >= 0x8 ) return 1;
1081: if ( d1[ind++]+((u2>>3)&0x7) >= 0x8 ) return 1;
1082: if ( d1[ind++]+(u2&0x7) >= 0x8 ) return 1;
1083: }
1084: return 0;
1085: break;
1086: case 4:
1087: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1088: u2 = d2[i];
1089: if ( d1[ind++]+((u2>>28)&0xf) >= 0x10 ) return 1;
1090: if ( d1[ind++]+((u2>>24)&0xf) >= 0x10 ) return 1;
1091: if ( d1[ind++]+((u2>>20)&0xf) >= 0x10 ) return 1;
1092: if ( d1[ind++]+((u2>>16)&0xf) >= 0x10 ) return 1;
1093: if ( d1[ind++]+((u2>>12)&0xf) >= 0x10 ) return 1;
1094: if ( d1[ind++]+((u2>>8)&0xf) >= 0x10 ) return 1;
1095: if ( d1[ind++]+((u2>>4)&0xf) >= 0x10 ) return 1;
1096: if ( d1[ind++]+(u2&0xf) >= 0x10 ) return 1;
1097: }
1098: return 0;
1099: break;
1100: case 6:
1101: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1102: u2 = d2[i];
1103: if ( d1[ind++]+((u2>>24)&0x3f) >= 0x40 ) return 1;
1104: if ( d1[ind++]+((u2>>18)&0x3f) >= 0x40 ) return 1;
1105: if ( d1[ind++]+((u2>>12)&0x3f) >= 0x40 ) return 1;
1106: if ( d1[ind++]+((u2>>6)&0x3f) >= 0x40 ) return 1;
1107: if ( d1[ind++]+(u2&0x3f) >= 0x40 ) return 1;
1108: }
1109: return 0;
1110: break;
1111: case 8:
1112: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1113: u2 = d2[i];
1114: if ( d1[ind++]+((u2>>24)&0xff) >= 0x100 ) return 1;
1115: if ( d1[ind++]+((u2>>16)&0xff) >= 0x100 ) return 1;
1116: if ( d1[ind++]+((u2>>8)&0xff) >= 0x100 ) return 1;
1117: if ( d1[ind++]+(u2&0xff) >= 0x100 ) return 1;
1118: }
1119: return 0;
1120: break;
1121: case 16:
1122: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1123: u2 = d2[i];
1124: if ( d1[ind++]+((u2>>16)&0xffff) > 0x10000 ) return 1;
1125: if ( d1[ind++]+(u2&0xffff) > 0x10000 ) return 1;
1126: }
1127: return 0;
1128: break;
1129: case 32:
1130: for ( i = nd_exporigin; i < nd_wpd; i++ )
1131: if ( d1[i]+d2[i]<d1[i] ) return 1;
1132: return 0;
1133: break;
1134: default:
1135: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1136: u2 = d2[i];
1137: k = (nd_epw-1)*nd_bpe;
1138: for ( j = 0; j < nd_epw; j++, k -= nd_bpe )
1139: if ( d1[ind++]+((u2>>k)&nd_mask0) > nd_mask0 ) return 1;
1140: }
1141: return 0;
1142: break;
1143: }
1144: #else
1145: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1146: u2 = d2[i];
1147: k = (nd_epw-1)*nd_bpe;
1148: for ( j = 0; j < nd_epw; j++, k -= nd_bpe )
1149: if ( d1[ind++]+((u2>>k)&nd_mask0) > nd_mask0 ) return 1;
1150: }
1151: return 0;
1152: #endif
1153: }
1154:
1155: int ndl_check_bound2(int index,UINT *d2)
1156: {
1157: return ndl_check_bound(nd_bound[index],d2);
1158: }
1159:
1160: INLINE int ndl_hash_value(UINT *d)
1161: {
1162: int i;
1.11 noro 1163: UINT r;
1.1 noro 1164:
1165: r = 0;
1166: for ( i = 0; i < nd_wpd; i++ )
1.12 noro 1167: r = (r*1511+d[i]);
1.11 noro 1168: r %= REDTAB_LEN;
1.1 noro 1169: return r;
1170: }
1171:
1172: INLINE int ndl_find_reducer(UINT *dg)
1173: {
1174: RHist r;
1175: int d,k,i;
1176:
1177: d = ndl_hash_value(dg);
1178: for ( r = nd_red[d], k = 0; r; r = NEXT(r), k++ ) {
1179: if ( ndl_equal(dg,DL(r)) ) {
1180: if ( k > 0 ) nd_notfirst++;
1181: nd_found++;
1182: return r->index;
1183: }
1184: }
1185: if ( Reverse )
1186: for ( i = nd_psn-1; i >= 0; i-- ) {
1187: r = nd_psh[i];
1188: if ( ndl_reducible(dg,DL(r)) ) {
1189: nd_create++;
1190: nd_append_red(dg,i);
1191: return i;
1192: }
1193: }
1194: else
1195: for ( i = 0; i < nd_psn; i++ ) {
1196: r = nd_psh[i];
1197: if ( ndl_reducible(dg,DL(r)) ) {
1198: nd_create++;
1199: nd_append_red(dg,i);
1200: return i;
1201: }
1202: }
1203: return -1;
1204: }
1205:
1.24 noro 1206: // ret=0,...,nd_psn-1 => reducer found
1207: // ret=nd_psn => reducer not found
1208: // ret=-1 => singular top reducible
1209:
1210: int comp_sig(SIG s1,SIG s2);
1211: void _ndltodl(UINT *ndl,DL dl);
1212:
1213: void print_sig(SIG s)
1214: {
1215: int i;
1216:
1217: fprintf(asir_out,"<<");
1218: for ( i = 0; i < nd_nvar; i++ ) {
1219: fprintf(asir_out,"%d",s->dl->d[i]);
1220: if ( i != nd_nvar-1 ) fprintf(asir_out,",");
1221: }
1222: fprintf(asir_out,">>*e%d",s->pos);
1223: }
1224:
1225: INLINE int ndl_find_reducer_s(UINT *dg,SIG sig)
1226: {
1227: RHist r;
1.27 noro 1228: int i,singular,ret,d,k;
1.26 noro 1229: static int wpd,nvar;
1.24 noro 1230: static SIG quo;
1231: static UINT *tmp;
1232:
1.26 noro 1233: if ( !quo || nvar != nd_nvar ) NEWSIG(quo);
1234: if ( wpd != nd_wpd ) {
1.24 noro 1235: wpd = nd_wpd;
1236: tmp = (UINT *)MALLOC(wpd*sizeof(UINT));
1237: }
1.27 noro 1238: d = ndl_hash_value(dg);
1239: for ( r = nd_red[d], k = 0; r; r = NEXT(r), k++ ) {
1240: if ( ndl_equal(dg,DL(r)) ) {
1241: return r->index;
1242: }
1243: }
1.24 noro 1244: singular = 0;
1245: for ( i = 0; i < nd_psn; i++ ) {
1246: r = nd_psh[i];
1247: if ( ndl_reducible(dg,DL(r)) ) {
1.27 noro 1248: ndl_sub(dg,DL(r),tmp);
1.24 noro 1249: _ndltodl(tmp,DL(quo));
1250: _addtodl(nd_nvar,DL(nd_psh[i]->sig),DL(quo));
1251: quo->pos = nd_psh[i]->sig->pos;
1252: ret = comp_sig(sig,quo);
1253: if ( ret > 0 ) { singular = 0; break; }
1.29 ! noro 1254: if ( ret == 0 ) { fprintf(asir_out,"s"); fflush(asir_out); singular = 1; }
1.24 noro 1255: }
1256: }
1257: if ( singular ) return -1;
1.27 noro 1258: else if ( i < nd_psn )
1259: nd_append_red(dg,i);
1260: return i;
1.24 noro 1261: }
1262:
1.1 noro 1263: ND nd_merge(ND p1,ND p2)
1264: {
1265: int n,c;
1266: int t,can,td1,td2;
1267: ND r;
1268: NM m1,m2,mr0,mr,s;
1269:
1270: if ( !p1 ) return p2;
1271: else if ( !p2 ) return p1;
1272: else {
1273: can = 0;
1274: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1275: c = DL_COMPARE(DL(m1),DL(m2));
1276: switch ( c ) {
1277: case 0:
1278: s = m1; m1 = NEXT(m1);
1279: can++; NEXTNM2(mr0,mr,s);
1280: s = m2; m2 = NEXT(m2); FREENM(s);
1281: break;
1282: case 1:
1283: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1284: break;
1285: case -1:
1286: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1287: break;
1288: }
1289: }
1290: if ( !mr0 )
1291: if ( m1 ) mr0 = m1;
1292: else if ( m2 ) mr0 = m2;
1293: else return 0;
1294: else if ( m1 ) NEXT(mr) = m1;
1295: else if ( m2 ) NEXT(mr) = m2;
1296: else NEXT(mr) = 0;
1297: BDY(p1) = mr0;
1298: SG(p1) = MAX(SG(p1),SG(p2));
1299: LEN(p1) = LEN(p1)+LEN(p2)-can;
1300: FREEND(p2);
1301: return p1;
1302: }
1303: }
1304:
1305: ND nd_add(int mod,ND p1,ND p2)
1306: {
1307: int n,c;
1308: int t,can,td1,td2;
1309: ND r;
1310: NM m1,m2,mr0,mr,s;
1311:
1.11 noro 1312: Nnd_add++;
1.1 noro 1313: if ( !p1 ) return p2;
1314: else if ( !p2 ) return p1;
1315: else if ( mod == -1 ) return nd_add_sf(p1,p2);
1316: else if ( mod == -2 ) return nd_add_lf(p1,p2);
1317: else if ( !mod ) return nd_add_q(p1,p2);
1318: else {
1319: can = 0;
1320: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1321: c = DL_COMPARE(DL(m1),DL(m2));
1322: switch ( c ) {
1323: case 0:
1324: t = ((CM(m1))+(CM(m2))) - mod;
1325: if ( t < 0 ) t += mod;
1326: s = m1; m1 = NEXT(m1);
1327: if ( t ) {
1328: can++; NEXTNM2(mr0,mr,s); CM(mr) = (t);
1329: } else {
1330: can += 2; FREENM(s);
1331: }
1332: s = m2; m2 = NEXT(m2); FREENM(s);
1333: break;
1334: case 1:
1335: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1336: break;
1337: case -1:
1338: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1339: break;
1340: }
1341: }
1342: if ( !mr0 )
1343: if ( m1 ) mr0 = m1;
1344: else if ( m2 ) mr0 = m2;
1345: else return 0;
1346: else if ( m1 ) NEXT(mr) = m1;
1347: else if ( m2 ) NEXT(mr) = m2;
1348: else NEXT(mr) = 0;
1349: BDY(p1) = mr0;
1350: SG(p1) = MAX(SG(p1),SG(p2));
1351: LEN(p1) = LEN(p1)+LEN(p2)-can;
1352: FREEND(p2);
1353: return p1;
1354: }
1355: }
1356:
1357: /* XXX on opteron, the inlined manipulation of destructive additon of
1358: * two NM seems to make gcc optimizer get confused, so the part is
1359: * done in a function.
1360: */
1361:
1362: int nm_destructive_add_q(NM *m1,NM *m2,NM *mr0,NM *mr)
1363: {
1364: NM s;
1365: P t;
1366: int can;
1367:
1368: addp(nd_vc,CP(*m1),CP(*m2),&t);
1369: s = *m1; *m1 = NEXT(*m1);
1370: if ( t ) {
1371: can = 1; NEXTNM2(*mr0,*mr,s); CP(*mr) = (t);
1372: } else {
1373: can = 2; FREENM(s);
1374: }
1375: s = *m2; *m2 = NEXT(*m2); FREENM(s);
1376: return can;
1377: }
1378:
1379: ND nd_add_q(ND p1,ND p2)
1380: {
1381: int n,c,can;
1382: ND r;
1383: NM m1,m2,mr0,mr,s;
1384: P t;
1385:
1386: if ( !p1 ) return p2;
1387: else if ( !p2 ) return p1;
1388: else {
1389: can = 0;
1390: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1391: c = DL_COMPARE(DL(m1),DL(m2));
1392: switch ( c ) {
1393: case 0:
1394: #if defined(__x86_64__)
1395: can += nm_destructive_add_q(&m1,&m2,&mr0,&mr);
1396: #else
1397: addp(nd_vc,CP(m1),CP(m2),&t);
1398: s = m1; m1 = NEXT(m1);
1399: if ( t ) {
1400: can++; NEXTNM2(mr0,mr,s); CP(mr) = (t);
1401: } else {
1402: can += 2; FREENM(s);
1403: }
1404: s = m2; m2 = NEXT(m2); FREENM(s);
1405: #endif
1406: break;
1407: case 1:
1408: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1409: break;
1410: case -1:
1411: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1412: break;
1413: }
1414: }
1415: if ( !mr0 )
1416: if ( m1 ) mr0 = m1;
1417: else if ( m2 ) mr0 = m2;
1418: else return 0;
1419: else if ( m1 ) NEXT(mr) = m1;
1420: else if ( m2 ) NEXT(mr) = m2;
1421: else NEXT(mr) = 0;
1422: BDY(p1) = mr0;
1423: SG(p1) = MAX(SG(p1),SG(p2));
1424: LEN(p1) = LEN(p1)+LEN(p2)-can;
1425: FREEND(p2);
1426: return p1;
1427: }
1428: }
1429:
1430: ND nd_add_sf(ND p1,ND p2)
1431: {
1432: int n,c,can;
1433: ND r;
1434: NM m1,m2,mr0,mr,s;
1435: int t;
1436:
1437: if ( !p1 ) return p2;
1438: else if ( !p2 ) return p1;
1439: else {
1440: can = 0;
1441: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1442: c = DL_COMPARE(DL(m1),DL(m2));
1443: switch ( c ) {
1444: case 0:
1445: t = _addsf(CM(m1),CM(m2));
1446: s = m1; m1 = NEXT(m1);
1447: if ( t ) {
1448: can++; NEXTNM2(mr0,mr,s); CM(mr) = (t);
1449: } else {
1450: can += 2; FREENM(s);
1451: }
1452: s = m2; m2 = NEXT(m2); FREENM(s);
1453: break;
1454: case 1:
1455: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1456: break;
1457: case -1:
1458: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1459: break;
1460: }
1461: }
1462: if ( !mr0 )
1463: if ( m1 ) mr0 = m1;
1464: else if ( m2 ) mr0 = m2;
1465: else return 0;
1466: else if ( m1 ) NEXT(mr) = m1;
1467: else if ( m2 ) NEXT(mr) = m2;
1468: else NEXT(mr) = 0;
1469: BDY(p1) = mr0;
1470: SG(p1) = MAX(SG(p1),SG(p2));
1471: LEN(p1) = LEN(p1)+LEN(p2)-can;
1472: FREEND(p2);
1473: return p1;
1474: }
1475: }
1476:
1477:
1478: ND nd_reduce2(int mod,ND d,ND g,NDV p,NM mul,NDC dn,Obj *divp)
1479: {
1480: int c,c1,c2;
1481: Z cg,cred,gcd,tq;
1482: P cgp,credp,gcdp;
1483: Obj tr,tr1;
1484:
1485: if ( mod == -1 ) {
1486: CM(mul) = _mulsf(_invsf(HCM(p)),_chsgnsf(HCM(g)));
1487: *divp = (Obj)ONE;
1488: } else if ( mod == -2 ) {
1489: Z inv,t;
1490: divlf(ONE,HCZ(p),&inv);
1491: chsgnlf(HCZ(g),&t);
1492: mullf(inv,t,&CZ(mul));
1493: *divp = (Obj)ONE;
1494: } else if ( mod ) {
1495: c1 = invm(HCM(p),mod); c2 = mod-HCM(g);
1496: DMAR(c1,c2,0,mod,c); CM(mul) = c;
1497: *divp = (Obj)ONE;
1498: } else if ( nd_vc ) {
1499: ezgcdpz(nd_vc,HCP(g),HCP(p),&gcdp);
1500: divsp(nd_vc,HCP(g),gcdp,&cgp); divsp(nd_vc,HCP(p),gcdp,&credp);
1501: chsgnp(cgp,&CP(mul));
1502: nd_mul_c_q(d,credp); nd_mul_c_q(g,credp);
1503: if ( dn ) {
1504: mulr(nd_vc,(Obj)dn->r,(Obj)credp,&tr);
1505: reductr(nd_vc,tr,&tr1); dn->r = (R)tr1;
1506: }
1507: *divp = (Obj)credp;
1508: } else {
1.6 noro 1509: igcd_cofactor(HCZ(g),HCZ(p),&gcd,&cg,&cred);
1510: chsgnz(cg,&CZ(mul));
1.1 noro 1511: nd_mul_c_q(d,(P)cred); nd_mul_c_q(g,(P)cred);
1512: if ( dn ) {
1513: mulz(dn->z,cred,&tq); dn->z = tq;
1514: }
1515: *divp = (Obj)cred;
1516: }
1517: return nd_add(mod,g,ndv_mul_nm(mod,mul,p));
1518: }
1519:
1520: /* ret=1 : success, ret=0 : overflow */
1.6 noro 1521: int nd_nf(int mod,ND d,ND g,NDV *ps,int full,ND *rp)
1.1 noro 1522: {
1523: NM m,mrd,tail;
1524: NM mul;
1525: int n,sugar,psugar,sugar0,stat,index;
1526: int c,c1,c2,dummy;
1527: RHist h;
1528: NDV p,red;
1529: Q cg,cred,gcd,tq,qq;
1530: Z iq;
1531: DP dmul;
1532: NODE node;
1533: LIST hist;
1534: double hmag;
1535: P tp,tp1;
1536: Obj tr,tr1,div;
1537: union oNDC hg;
1538: P cont;
1539:
1540: if ( !g ) {
1541: *rp = d;
1542: return 1;
1543: }
1544: if ( !mod ) hmag = ((double)p_mag(HCP(g)))*nd_scale;
1545:
1546: sugar0 = sugar = SG(g);
1547: n = NV(g);
1548: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
1549: if ( d )
1550: for ( tail = BDY(d); NEXT(tail); tail = NEXT(tail) );
1551: for ( ; g; ) {
1552: index = ndl_find_reducer(HDL(g));
1553: if ( index >= 0 ) {
1554: h = nd_psh[index];
1555: ndl_sub(HDL(g),DL(h),DL(mul));
1556: if ( ndl_check_bound2(index,DL(mul)) ) {
1557: nd_free(g); nd_free(d);
1558: return 0;
1559: }
1560: p = nd_demand ? ndv_load(index) : ps[index];
1561: /* d+g -> div*(d+g)+mul*p */
1.6 noro 1562: g = nd_reduce2(mod,d,g,p,mul,0,&div);
1.1 noro 1563: if ( nd_gentrace ) {
1564: /* Trace=[div,index,mul,ONE] */
1.6 noro 1565: STOZ(index,iq);
1.1 noro 1566: nmtodp(mod,mul,&dmul);
1567: node = mknode(4,div,iq,dmul,ONE);
1568: }
1569: sugar = MAX(sugar,SG(p)+TD(DL(mul)));
1570: if ( !mod && g && !nd_vc && ((double)(p_mag(HCP(g))) > hmag) ) {
1571: hg = HCU(g);
1572: nd_removecont2(d,g);
1.6 noro 1573: if ( nd_gentrace ) {
1.1 noro 1574: /* overwrite cont : Trace=[div,index,mul,cont] */
1.6 noro 1575: /* exact division */
1.1 noro 1576: cont = ndc_div(mod,hg,HCU(g));
1577: if ( nd_gentrace && !UNIQ(cont) ) ARG3(node) = (pointer)cont;
1578: }
1579: hmag = ((double)p_mag(HCP(g)))*nd_scale;
1580: }
1581: MKLIST(hist,node);
1582: MKNODE(node,hist,nd_tracelist); nd_tracelist = node;
1583: } else if ( !full ) {
1584: *rp = g;
1585: return 1;
1586: } else {
1587: m = BDY(g);
1588: if ( NEXT(m) ) {
1589: BDY(g) = NEXT(m); NEXT(m) = 0; LEN(g)--;
1590: } else {
1591: FREEND(g); g = 0;
1592: }
1593: if ( d ) {
1594: NEXT(tail)=m; tail=m; LEN(d)++;
1595: } else {
1596: MKND(n,m,1,d); tail = BDY(d);
1597: }
1598: }
1599: }
1600: if ( d ) SG(d) = sugar;
1601: *rp = d;
1602: return 1;
1603: }
1604:
1.24 noro 1605: // ret=1 => success
1606: // ret=0 => overflow
1607: // ret=-1 => singular top reducible
1608:
1609: int nd_nf_s(int mod,ND d,ND g,NDV *ps,int full,ND *rp)
1610: {
1611: NM m,mrd,tail;
1612: NM mul;
1613: int n,sugar,psugar,sugar0,stat,index;
1614: int c,c1,c2,dummy;
1615: RHist h;
1616: NDV p,red;
1617: Q cg,cred,gcd,tq,qq;
1618: Z iq;
1619: DP dmul;
1620: NODE node;
1621: LIST hist;
1622: double hmag;
1623: P tp,tp1;
1624: Obj tr,tr1,div;
1625: union oNDC hg;
1626: P cont;
1627: SIG sig;
1628:
1629: if ( !g ) {
1630: *rp = d;
1631: return 1;
1632: }
1633: if ( !mod ) hmag = ((double)p_mag(HCP(g)))*nd_scale;
1634:
1635: sugar0 = sugar = SG(g);
1636: n = NV(g);
1637: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
1638: if ( d )
1639: for ( tail = BDY(d); NEXT(tail); tail = NEXT(tail) );
1640: sig = g->sig;
1641: for ( ; g; ) {
1642: index = ndl_find_reducer_s(HDL(g),sig);
1643: if ( index >= 0 && index < nd_psn ) {
1644: // reducer found
1645: h = nd_psh[index];
1646: ndl_sub(HDL(g),DL(h),DL(mul));
1647: if ( ndl_check_bound2(index,DL(mul)) ) {
1648: nd_free(g); nd_free(d);
1649: return 0;
1650: }
1651: p = ps[index];
1652: /* d+g -> div*(d+g)+mul*p */
1653: g = nd_reduce2(mod,d,g,p,mul,0,&div);
1654: sugar = MAX(sugar,SG(p)+TD(DL(mul)));
1655: if ( !mod && g && ((double)(p_mag(HCP(g))) > hmag) ) {
1656: hg = HCU(g);
1657: nd_removecont2(d,g);
1658: hmag = ((double)p_mag(HCP(g)))*nd_scale;
1659: }
1660: } else if ( index == -1 ) {
1661: // singular top reducible
1662: return -1;
1663: } else if ( !full ) {
1664: *rp = g;
1665: g->sig = sig;
1666: return 1;
1667: } else {
1668: m = BDY(g);
1669: if ( NEXT(m) ) {
1670: BDY(g) = NEXT(m); NEXT(m) = 0; LEN(g)--;
1671: } else {
1672: FREEND(g); g = 0;
1673: }
1674: if ( d ) {
1675: NEXT(tail)=m; tail=m; LEN(d)++;
1676: } else {
1677: MKND(n,m,1,d); tail = BDY(d);
1678: }
1679: }
1680: }
1681: if ( d ) {
1682: SG(d) = sugar;
1683: d->sig = sig;
1684: }
1685: *rp = d;
1686: return 1;
1687: }
1688:
1.1 noro 1689: int nd_nf_pbucket(int mod,ND g,NDV *ps,int full,ND *rp)
1690: {
1691: int hindex,index;
1692: NDV p;
1693: ND u,d,red;
1694: NODE l;
1695: NM mul,m,mrd,tail;
1696: int sugar,psugar,n,h_reducible;
1697: PGeoBucket bucket;
1698: int c,c1,c2;
1699: Z cg,cred,gcd,zzz;
1700: RHist h;
1701: double hmag,gmag;
1702: int count = 0;
1703: int hcount = 0;
1704:
1705: if ( !g ) {
1706: *rp = 0;
1707: return 1;
1708: }
1709: sugar = SG(g);
1710: n = NV(g);
1.6 noro 1711: if ( !mod ) hmag = ((double)p_mag((P)HCZ(g)))*nd_scale;
1.1 noro 1712: bucket = create_pbucket();
1713: add_pbucket(mod,bucket,g);
1714: d = 0;
1715: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
1716: while ( 1 ) {
1717: if ( mod > 0 || mod == -1 )
1718: hindex = head_pbucket(mod,bucket);
1719: else if ( mod == -2 )
1720: hindex = head_pbucket_lf(bucket);
1721: else
1722: hindex = head_pbucket_q(bucket);
1723: if ( hindex < 0 ) {
1724: if ( DP_Print > 3 ) printf("(%d %d)",count,hcount);
1725: if ( d ) SG(d) = sugar;
1726: *rp = d;
1727: return 1;
1728: }
1729: g = bucket->body[hindex];
1730: index = ndl_find_reducer(HDL(g));
1731: if ( index >= 0 ) {
1732: count++;
1733: if ( !d ) hcount++;
1734: h = nd_psh[index];
1735: ndl_sub(HDL(g),DL(h),DL(mul));
1736: if ( ndl_check_bound2(index,DL(mul)) ) {
1737: nd_free(d);
1738: free_pbucket(bucket);
1739: *rp = 0;
1740: return 0;
1741: }
1742: p = ps[index];
1743: if ( mod == -1 )
1744: CM(mul) = _mulsf(_invsf(HCM(p)),_chsgnsf(HCM(g)));
1745: else if ( mod == -2 ) {
1746: Z inv,t;
1747: divlf(ONE,HCZ(p),&inv);
1748: chsgnlf(HCZ(g),&t);
1749: mullf(inv,t,&CZ(mul));
1750: } else if ( mod ) {
1751: c1 = invm(HCM(p),mod); c2 = mod-HCM(g);
1752: DMAR(c1,c2,0,mod,c); CM(mul) = c;
1753: } else {
1.6 noro 1754: igcd_cofactor(HCZ(g),HCZ(p),&gcd,&cg,&cred);
1755: chsgnz(cg,&CZ(mul));
1.1 noro 1756: nd_mul_c_q(d,(P)cred);
1757: mulq_pbucket(bucket,cred);
1758: g = bucket->body[hindex];
1.6 noro 1759: gmag = (double)p_mag((P)HCZ(g));
1.1 noro 1760: }
1761: red = ndv_mul_nm(mod,mul,p);
1762: bucket->body[hindex] = nd_remove_head(g);
1763: red = nd_remove_head(red);
1764: add_pbucket(mod,bucket,red);
1765: psugar = SG(p)+TD(DL(mul));
1766: sugar = MAX(sugar,psugar);
1767: if ( !mod && hmag && (gmag > hmag) ) {
1768: g = normalize_pbucket(mod,bucket);
1769: if ( !g ) {
1770: if ( d ) SG(d) = sugar;
1771: *rp = d;
1772: return 1;
1773: }
1774: nd_removecont2(d,g);
1.6 noro 1775: hmag = ((double)p_mag((P)HCZ(g)))*nd_scale;
1.1 noro 1776: add_pbucket(mod,bucket,g);
1777: }
1778: } else if ( !full ) {
1779: g = normalize_pbucket(mod,bucket);
1780: if ( g ) SG(g) = sugar;
1781: *rp = g;
1782: return 1;
1783: } else {
1784: m = BDY(g);
1785: if ( NEXT(m) ) {
1786: BDY(g) = NEXT(m); NEXT(m) = 0; LEN(g)--;
1787: } else {
1788: FREEND(g); g = 0;
1789: }
1790: bucket->body[hindex] = g;
1791: NEXT(m) = 0;
1792: if ( d ) {
1793: NEXT(tail)=m; tail=m; LEN(d)++;
1794: } else {
1795: MKND(n,m,1,d); tail = BDY(d);
1796: }
1797: }
1798: }
1799: }
1800:
1.25 noro 1801: int nd_nf_pbucket_s(int mod,ND g,NDV *ps,int full,ND *rp)
1802: {
1803: int hindex,index;
1804: NDV p;
1805: ND u,d,red;
1806: NODE l;
1807: NM mul,m,mrd,tail;
1808: int sugar,psugar,n,h_reducible;
1809: PGeoBucket bucket;
1810: int c,c1,c2;
1811: Z cg,cred,gcd,zzz;
1812: RHist h;
1813: double hmag,gmag;
1814: int count = 0;
1815: int hcount = 0;
1816: SIG sig;
1817:
1818: if ( !g ) {
1819: *rp = 0;
1820: return 1;
1821: }
1822: sugar = SG(g);
1823: n = NV(g);
1824: if ( !mod ) hmag = ((double)p_mag((P)HCZ(g)))*nd_scale;
1825: bucket = create_pbucket();
1826: add_pbucket(mod,bucket,g);
1827: d = 0;
1828: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
1829: sig = g->sig;
1830: while ( 1 ) {
1831: if ( mod > 0 || mod == -1 )
1832: hindex = head_pbucket(mod,bucket);
1833: else if ( mod == -2 )
1834: hindex = head_pbucket_lf(bucket);
1835: else
1836: hindex = head_pbucket_q(bucket);
1837: if ( hindex < 0 ) {
1838: if ( DP_Print > 3 ) printf("(%d %d)",count,hcount);
1839: if ( d ) {
1840: SG(d) = sugar;
1841: d->sig = sig;
1842: }
1843: *rp = d;
1844: return 1;
1845: }
1846: g = bucket->body[hindex];
1847: index = ndl_find_reducer_s(HDL(g),sig);
1848: if ( index >= 0 && index < nd_psn ) {
1849: count++;
1850: if ( !d ) hcount++;
1851: h = nd_psh[index];
1852: ndl_sub(HDL(g),DL(h),DL(mul));
1853: if ( ndl_check_bound2(index,DL(mul)) ) {
1854: nd_free(d);
1855: free_pbucket(bucket);
1856: *rp = 0;
1857: return 0;
1858: }
1859: p = ps[index];
1860: if ( mod == -1 )
1861: CM(mul) = _mulsf(_invsf(HCM(p)),_chsgnsf(HCM(g)));
1862: else if ( mod == -2 ) {
1863: Z inv,t;
1864: divlf(ONE,HCZ(p),&inv);
1865: chsgnlf(HCZ(g),&t);
1866: mullf(inv,t,&CZ(mul));
1867: } else if ( mod ) {
1868: c1 = invm(HCM(p),mod); c2 = mod-HCM(g);
1869: DMAR(c1,c2,0,mod,c); CM(mul) = c;
1870: } else {
1871: igcd_cofactor(HCZ(g),HCZ(p),&gcd,&cg,&cred);
1872: chsgnz(cg,&CZ(mul));
1873: nd_mul_c_q(d,(P)cred);
1874: mulq_pbucket(bucket,cred);
1875: g = bucket->body[hindex];
1876: gmag = (double)p_mag((P)HCZ(g));
1877: }
1878: red = ndv_mul_nm(mod,mul,p);
1879: bucket->body[hindex] = nd_remove_head(g);
1880: red = nd_remove_head(red);
1881: add_pbucket(mod,bucket,red);
1882: psugar = SG(p)+TD(DL(mul));
1883: sugar = MAX(sugar,psugar);
1884: if ( !mod && hmag && (gmag > hmag) ) {
1885: g = normalize_pbucket(mod,bucket);
1886: if ( !g ) {
1887: if ( d ) {
1888: SG(d) = sugar;
1889: d->sig = sig;
1890: }
1891: *rp = d;
1892: return 1;
1893: }
1894: nd_removecont2(d,g);
1895: hmag = ((double)p_mag((P)HCZ(g)))*nd_scale;
1896: add_pbucket(mod,bucket,g);
1897: }
1898: } else if ( index == -1 ) {
1899: // singular top reducible
1900: return -1;
1901: } else if ( !full ) {
1902: g = normalize_pbucket(mod,bucket);
1903: if ( g ) {
1904: SG(g) = sugar;
1905: g->sig = sig;
1906: }
1907: *rp = g;
1908: return 1;
1909: } else {
1910: m = BDY(g);
1911: if ( NEXT(m) ) {
1912: BDY(g) = NEXT(m); NEXT(m) = 0; LEN(g)--;
1913: } else {
1914: FREEND(g); g = 0;
1915: }
1916: bucket->body[hindex] = g;
1917: NEXT(m) = 0;
1918: if ( d ) {
1919: NEXT(tail)=m; tail=m; LEN(d)++;
1920: } else {
1921: MKND(n,m,1,d); tail = BDY(d);
1922: }
1923: }
1924: }
1925: }
1926:
1.1 noro 1927: /* input : list of NDV, cand : list of NDV */
1928:
1929: int ndv_check_membership(int m,NODE input,int obpe,int oadv,EPOS oepos,NODE cand)
1930: {
1931: int n,i,stat;
1932: ND nf,d;
1933: NDV r;
1934: NODE t,s;
1935: union oNDC dn;
1936: Z q;
1937: LIST list;
1938:
1.24 noro 1939: ndv_setup(m,0,cand,nd_gentrace?1:0,1,0);
1.1 noro 1940: n = length(cand);
1941:
1942: if ( nd_gentrace ) { nd_alltracelist = 0; nd_tracelist = 0; }
1943: /* membercheck : list is a subset of Id(cand) ? */
1944: for ( t = input, i = 0; t; t = NEXT(t), i++ ) {
1945: again:
1946: nd_tracelist = 0;
1947: if ( nd_bpe > obpe )
1948: r = ndv_dup_realloc((NDV)BDY(t),obpe,oadv,oepos);
1949: else
1950: r = (NDV)BDY(t);
1951: #if 0
1952: // moved to nd_f4_lf_trace()
1953: if ( m == -2 ) ndv_mod(m,r);
1954: #endif
1955: d = ndvtond(m,r);
1.6 noro 1956: stat = nd_nf(m,0,d,nd_ps,0,&nf);
1.1 noro 1957: if ( !stat ) {
1958: nd_reconstruct(0,0);
1959: goto again;
1960: } else if ( nf ) return 0;
1961: if ( nd_gentrace ) {
1962: nd_tracelist = reverse_node(nd_tracelist);
1963: MKLIST(list,nd_tracelist);
1.6 noro 1964: STOZ(i,q); s = mknode(2,q,list); MKLIST(list,s);
1.1 noro 1965: MKNODE(s,list,nd_alltracelist);
1966: nd_alltracelist = s; nd_tracelist = 0;
1967: }
1968: if ( DP_Print ) { printf("."); fflush(stdout); }
1969: }
1970: if ( DP_Print ) { printf("\n"); }
1971: return 1;
1972: }
1973:
1974: ND nd_remove_head(ND p)
1975: {
1976: NM m;
1977:
1978: m = BDY(p);
1979: if ( !NEXT(m) ) {
1980: FREEND(p); p = 0;
1981: } else {
1982: BDY(p) = NEXT(m); LEN(p)--;
1983: }
1984: FREENM(m);
1985: return p;
1986: }
1987:
1988: ND nd_separate_head(ND p,ND *head)
1989: {
1990: NM m,m0;
1991: ND r;
1992:
1993: m = BDY(p);
1994: if ( !NEXT(m) ) {
1995: *head = p; p = 0;
1996: } else {
1997: m0 = m;
1998: BDY(p) = NEXT(m); LEN(p)--;
1999: NEXT(m0) = 0;
2000: MKND(NV(p),m0,1,r);
2001: *head = r;
2002: }
2003: return p;
2004: }
2005:
2006: PGeoBucket create_pbucket()
2007: {
2008: PGeoBucket g;
2009:
2010: g = CALLOC(1,sizeof(struct oPGeoBucket));
2011: g->m = -1;
2012: return g;
2013: }
2014:
2015: void free_pbucket(PGeoBucket b) {
2016: int i;
2017:
2018: for ( i = 0; i <= b->m; i++ )
2019: if ( b->body[i] ) {
2020: nd_free(b->body[i]);
2021: b->body[i] = 0;
2022: }
2023: GCFREE(b);
2024: }
2025:
2026: void add_pbucket_symbolic(PGeoBucket g,ND d)
2027: {
2028: int l,i,k,m;
2029:
2030: if ( !d )
2031: return;
2032: l = LEN(d);
2033: for ( k = 0, m = 1; l > m; k++, m <<= 1 );
2034: /* 2^(k-1) < l <= 2^k (=m) */
2035: d = nd_merge(g->body[k],d);
2036: for ( ; d && LEN(d) > m; k++, m <<= 1 ) {
2037: g->body[k] = 0;
2038: d = nd_merge(g->body[k+1],d);
2039: }
2040: g->body[k] = d;
2041: g->m = MAX(g->m,k);
2042: }
2043:
2044: void add_pbucket(int mod,PGeoBucket g,ND d)
2045: {
2046: int l,i,k,m;
2047:
2048: if ( !d )
2049: return;
2050: l = LEN(d);
2051: for ( k = 0, m = 1; l > m; k++, m <<= 1 );
2052: /* 2^(k-1) < l <= 2^k (=m) */
2053: d = nd_add(mod,g->body[k],d);
2054: for ( ; d && LEN(d) > m; k++, m <<= 1 ) {
2055: g->body[k] = 0;
2056: d = nd_add(mod,g->body[k+1],d);
2057: }
2058: g->body[k] = d;
2059: g->m = MAX(g->m,k);
2060: }
2061:
2062: void mulq_pbucket(PGeoBucket g,Z c)
2063: {
2064: int k;
2065:
2066: for ( k = 0; k <= g->m; k++ )
2067: nd_mul_c_q(g->body[k],(P)c);
2068: }
2069:
2070: NM remove_head_pbucket_symbolic(PGeoBucket g)
2071: {
2072: int j,i,k,c;
2073: NM head;
2074:
2075: k = g->m;
2076: j = -1;
2077: for ( i = 0; i <= k; i++ ) {
2078: if ( !g->body[i] ) continue;
2079: if ( j < 0 ) j = i;
2080: else {
2081: c = DL_COMPARE(HDL(g->body[i]),HDL(g->body[j]));
2082: if ( c > 0 )
2083: j = i;
2084: else if ( c == 0 )
2085: g->body[i] = nd_remove_head(g->body[i]);
2086: }
2087: }
2088: if ( j < 0 ) return 0;
2089: else {
2090: head = BDY(g->body[j]);
2091: if ( !NEXT(head) ) {
2092: FREEND(g->body[j]);
2093: g->body[j] = 0;
2094: } else {
2095: BDY(g->body[j]) = NEXT(head);
2096: LEN(g->body[j])--;
2097: }
2098: return head;
2099: }
2100: }
2101:
2102: int head_pbucket(int mod,PGeoBucket g)
2103: {
2104: int j,i,c,k,nv,sum;
2105: UINT *di,*dj;
2106: ND gi,gj;
2107:
2108: k = g->m;
2109: while ( 1 ) {
2110: j = -1;
2111: for ( i = 0; i <= k; i++ ) {
2112: if ( !(gi = g->body[i]) )
2113: continue;
2114: if ( j < 0 ) {
2115: j = i;
2116: gj = g->body[j];
2117: dj = HDL(gj);
2118: sum = HCM(gj);
2119: } else {
2120: c = DL_COMPARE(HDL(gi),dj);
2121: if ( c > 0 ) {
2122: if ( sum ) HCM(gj) = sum;
2123: else g->body[j] = nd_remove_head(gj);
2124: j = i;
2125: gj = g->body[j];
2126: dj = HDL(gj);
2127: sum = HCM(gj);
2128: } else if ( c == 0 ) {
2129: if ( mod == -1 )
2130: sum = _addsf(sum,HCM(gi));
2131: else {
2132: sum = sum+HCM(gi)-mod;
2133: if ( sum < 0 ) sum += mod;
2134: }
2135: g->body[i] = nd_remove_head(gi);
2136: }
2137: }
2138: }
2139: if ( j < 0 ) return -1;
2140: else if ( sum ) {
2141: HCM(gj) = sum;
2142: return j;
2143: } else
2144: g->body[j] = nd_remove_head(gj);
2145: }
2146: }
2147:
2148: int head_pbucket_q(PGeoBucket g)
2149: {
2150: int j,i,c,k,nv;
2151: Z sum,t;
2152: ND gi,gj;
2153:
2154: k = g->m;
2155: while ( 1 ) {
2156: j = -1;
2157: for ( i = 0; i <= k; i++ ) {
2158: if ( !(gi = g->body[i]) ) continue;
2159: if ( j < 0 ) {
2160: j = i;
2161: gj = g->body[j];
1.6 noro 2162: sum = HCZ(gj);
1.1 noro 2163: } else {
2164: nv = NV(gi);
2165: c = DL_COMPARE(HDL(gi),HDL(gj));
2166: if ( c > 0 ) {
1.6 noro 2167: if ( sum ) HCZ(gj) = sum;
1.1 noro 2168: else g->body[j] = nd_remove_head(gj);
2169: j = i;
2170: gj = g->body[j];
1.6 noro 2171: sum = HCZ(gj);
1.1 noro 2172: } else if ( c == 0 ) {
1.6 noro 2173: addz(sum,HCZ(gi),&t);
1.1 noro 2174: sum = t;
2175: g->body[i] = nd_remove_head(gi);
2176: }
2177: }
2178: }
2179: if ( j < 0 ) return -1;
2180: else if ( sum ) {
1.6 noro 2181: HCZ(gj) = sum;
1.1 noro 2182: return j;
2183: } else
2184: g->body[j] = nd_remove_head(gj);
2185: }
2186: }
2187:
2188: int head_pbucket_lf(PGeoBucket g)
2189: {
2190: int j,i,c,k,nv;
2191: Z sum,t;
2192: ND gi,gj;
2193:
2194: k = g->m;
2195: while ( 1 ) {
2196: j = -1;
2197: for ( i = 0; i <= k; i++ ) {
2198: if ( !(gi = g->body[i]) ) continue;
2199: if ( j < 0 ) {
2200: j = i;
2201: gj = g->body[j];
2202: sum = HCZ(gj);
2203: } else {
2204: nv = NV(gi);
2205: c = DL_COMPARE(HDL(gi),HDL(gj));
2206: if ( c > 0 ) {
2207: if ( sum ) HCZ(gj) = sum;
2208: else g->body[j] = nd_remove_head(gj);
2209: j = i;
2210: gj = g->body[j];
2211: sum = HCZ(gj);
2212: } else if ( c == 0 ) {
2213: addlf(sum,HCZ(gi),&t);
2214: sum = t;
2215: g->body[i] = nd_remove_head(gi);
2216: }
2217: }
2218: }
2219: if ( j < 0 ) return -1;
2220: else if ( sum ) {
2221: HCZ(gj) = sum;
2222: return j;
2223: } else
2224: g->body[j] = nd_remove_head(gj);
2225: }
2226: }
2227:
2228: ND normalize_pbucket(int mod,PGeoBucket g)
2229: {
2230: int i;
2231: ND r,t;
2232:
2233: r = 0;
2234: for ( i = 0; i <= g->m; i++ ) {
2235: r = nd_add(mod,r,g->body[i]);
2236: g->body[i] = 0;
2237: }
2238: g->m = -1;
2239: return r;
2240: }
2241:
2242: #if 0
2243: void register_hcf(NDV p)
2244: {
2245: DCP dc,t;
2246: P hc,h;
2247: int c;
2248: NODE l,l1,prev;
2249:
2250: hc = p->body->c.p;
2251: if ( !nd_vc || NUM(hc) ) return;
2252: fctrp(nd_vc,hc,&dc);
2253: for ( t = dc; t; t = NEXT(t) ) {
2254: h = t->c;
2255: if ( NUM(h) ) continue;
2256: for ( prev = 0, l = nd_hcf; l; prev = l, l = NEXT(l) ) {
2257: c = compp(nd_vc,h,(P)BDY(l));
2258: if ( c >= 0 ) break;
2259: }
2260: if ( !l || c > 0 ) {
2261: MKNODE(l1,h,l);
2262: if ( !prev )
2263: nd_hcf = l1;
2264: else
2265: NEXT(prev) = l1;
2266: }
2267: }
2268: }
2269: #else
2270: void register_hcf(NDV p)
2271: {
2272: DCP dc,t;
2273: P hc,h,q;
2274: Q dmy;
2275: int c;
2276: NODE l,l1,prev;
2277:
2278: hc = p->body->c.p;
2279: if ( NUM(hc) ) return;
2280: ptozp(hc,1,&dmy,&h);
2281: #if 1
2282: for ( l = nd_hcf; l; l = NEXT(l) ) {
2283: while ( 1 ) {
2284: if ( divtpz(nd_vc,h,(P)BDY(l),&q) ) h = q;
2285: else break;
2286: }
2287: }
2288: if ( NUM(h) ) return;
2289: #endif
2290: for ( prev = 0, l = nd_hcf; l; prev = l, l = NEXT(l) ) {
2291: c = compp(nd_vc,h,(P)BDY(l));
2292: if ( c >= 0 ) break;
2293: }
2294: if ( !l || c > 0 ) {
2295: MKNODE(l1,h,l);
2296: if ( !prev )
2297: nd_hcf = l1;
2298: else
2299: NEXT(prev) = l1;
2300: }
2301: }
2302: #endif
2303:
2304: int do_diagonalize(int sugar,int m)
2305: {
1.6 noro 2306: int i,nh,stat;
2307: NODE r,g,t;
2308: ND h,nf,s,head;
2309: NDV nfv;
2310: Q q;
2311: P nm,nmp,dn,mnp,dnp,cont,cont1;
2312: union oNDC hc;
2313: NODE node;
2314: LIST l;
2315: Z iq;
1.1 noro 2316:
1.6 noro 2317: for ( i = nd_psn-1; i >= 0 && SG(nd_psh[i]) == sugar; i-- ) {
2318: if ( nd_gentrace ) {
2319: /* Trace = [1,index,1,1] */
2320: STOZ(i,iq); node = mknode(4,ONE,iq,ONE,ONE);
2321: MKLIST(l,node); MKNODE(nd_tracelist,l,0);
2322: }
2323: if ( nd_demand )
2324: nfv = ndv_load(i);
2325: else
2326: nfv = nd_ps[i];
2327: s = ndvtond(m,nfv);
2328: s = nd_separate_head(s,&head);
2329: stat = nd_nf(m,head,s,nd_ps,1,&nf);
2330: if ( !stat ) return 0;
2331: ndv_free(nfv);
2332: hc = HCU(nf); nd_removecont(m,nf);
2333: /* exact division */
2334: cont = ndc_div(m,hc,HCU(nf));
1.1 noro 2335: if ( nd_gentrace ) finalize_tracelist(i,cont);
1.6 noro 2336: nfv = ndtondv(m,nf);
2337: nd_free(nf);
2338: nd_bound[i] = ndv_compute_bound(nfv);
2339: if ( !m ) register_hcf(nfv);
2340: if ( nd_demand ) {
2341: ndv_save(nfv,i);
2342: ndv_free(nfv);
2343: } else
2344: nd_ps[i] = nfv;
2345: }
2346: return 1;
1.1 noro 2347: }
2348:
2349: LIST compute_splist()
2350: {
2351: NODE g,tn0,tn,node;
2352: LIST l0;
2353: ND_pairs d,t;
2354: int i;
2355: Z i1,i2;
2356:
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: for ( t = d, tn0 = 0; t; t = NEXT(t) ) {
2363: NEXTNODE(tn0,tn);
1.6 noro 2364: STOZ(t->i1,i1); STOZ(t->i2,i2);
1.1 noro 2365: node = mknode(2,i1,i2); MKLIST(l0,node);
2366: BDY(tn) = l0;
2367: }
2368: if ( tn0 ) NEXT(tn) = 0; MKLIST(l0,tn0);
2369: return l0;
2370: }
2371:
2372: /* return value = 0 => input is not a GB */
2373:
2374: NODE nd_gb(int m,int ishomo,int checkonly,int gensyz,int **indp)
2375: {
1.6 noro 2376: int i,nh,sugar,stat;
2377: NODE r,g,t;
2378: ND_pairs d;
2379: ND_pairs l;
2380: ND h,nf,s,head,nf1;
2381: NDV nfv;
2382: Z q;
2383: union oNDC dn,hc;
2384: int diag_count = 0;
2385: P cont;
2386: LIST list;
1.27 noro 2387: struct oEGT eg1,eg2,eg_update;
1.6 noro 2388:
1.27 noro 2389: init_eg(&eg_update);
1.11 noro 2390: Nnd_add = 0;
1.6 noro 2391: g = 0; d = 0;
2392: for ( i = 0; i < nd_psn; i++ ) {
2393: d = update_pairs(d,g,i,gensyz);
2394: g = update_base(g,i);
2395: }
2396: sugar = 0;
2397: while ( d ) {
1.1 noro 2398: again:
1.6 noro 2399: l = nd_minp(d,&d);
2400: if ( MaxDeg > 0 && SG(l) > MaxDeg ) break;
2401: if ( SG(l) != sugar ) {
2402: if ( ishomo ) {
2403: diag_count = 0;
2404: stat = do_diagonalize(sugar,m);
1.1 noro 2405: if ( !stat ) {
1.6 noro 2406: NEXT(l) = d; d = l;
2407: d = nd_reconstruct(0,d);
2408: goto again;
1.1 noro 2409: }
1.6 noro 2410: }
2411: sugar = SG(l);
2412: if ( DP_Print ) fprintf(asir_out,"%d",sugar);
2413: }
2414: stat = nd_sp(m,0,l,&h);
2415: if ( !stat ) {
2416: NEXT(l) = d; d = l;
2417: d = nd_reconstruct(0,d);
2418: goto again;
2419: }
1.1 noro 2420: #if USE_GEOBUCKET
1.6 noro 2421: stat = (m&&!nd_gentrace)?nd_nf_pbucket(m,h,nd_ps,!Top,&nf)
2422: :nd_nf(m,0,h,nd_ps,!Top,&nf);
1.1 noro 2423: #else
1.6 noro 2424: stat = nd_nf(m,0,h,nd_ps,!Top,&nf);
1.1 noro 2425: #endif
1.6 noro 2426: if ( !stat ) {
2427: NEXT(l) = d; d = l;
2428: d = nd_reconstruct(0,d);
2429: goto again;
2430: } else if ( nf ) {
2431: if ( checkonly || gensyz ) return 0;
1.1 noro 2432: if ( nd_newelim ) {
2433: if ( nd_module ) {
2434: if ( MPOS(HDL(nf)) > 1 ) return 0;
2435: } else if ( !(HDL(nf)[nd_exporigin] & nd_mask[0]) ) return 0;
2436: }
1.6 noro 2437: if ( DP_Print ) { printf("+"); fflush(stdout); }
2438: hc = HCU(nf);
2439: nd_removecont(m,nf);
2440: if ( !m && nd_nalg ) {
2441: nd_monic(0,&nf);
2442: nd_removecont(m,nf);
2443: }
2444: if ( nd_gentrace ) {
2445: /* exact division */
1.1 noro 2446: cont = ndc_div(m,hc,HCU(nf));
2447: if ( m || !UNIQ(cont) ) {
1.6 noro 2448: t = mknode(4,NULLP,NULLP,NULLP,cont);
2449: MKLIST(list,t); MKNODE(t,list,nd_tracelist);
1.1 noro 2450: nd_tracelist = t;
2451: }
2452: }
1.6 noro 2453: nfv = ndtondv(m,nf); nd_free(nf);
1.24 noro 2454: nh = ndv_newps(m,nfv,0);
1.6 noro 2455: if ( !m && (ishomo && ++diag_count == diag_period) ) {
2456: diag_count = 0;
2457: stat = do_diagonalize(sugar,m);
2458: if ( !stat ) {
2459: NEXT(l) = d; d = l;
2460: d = nd_reconstruct(1,d);
2461: goto again;
1.1 noro 2462: }
1.6 noro 2463: }
1.27 noro 2464: get_eg(&eg1);
1.6 noro 2465: d = update_pairs(d,g,nh,0);
1.27 noro 2466: get_eg(&eg2); add_eg(&eg_update,&eg1,&eg2);
1.6 noro 2467: g = update_base(g,nh);
2468: FREENDP(l);
2469: } else {
2470: if ( nd_gentrace && gensyz ) {
2471: nd_tracelist = reverse_node(nd_tracelist);
2472: MKLIST(list,nd_tracelist);
2473: STOZ(-1,q); t = mknode(2,q,list); MKLIST(list,t);
2474: MKNODE(t,list,nd_alltracelist);
2475: nd_alltracelist = t; nd_tracelist = 0;
2476: }
2477: if ( DP_Print ) { printf("."); fflush(stdout); }
2478: FREENDP(l);
2479: }
2480: }
2481: conv_ilist(nd_demand,0,g,indp);
1.11 noro 2482: if ( !checkonly && DP_Print ) { printf("nd_gb done. Number of nd_add=%d\n",Nnd_add); fflush(stdout); }
1.27 noro 2483: print_eg("update",&eg_update);
1.1 noro 2484: return g;
2485: }
2486:
1.29 ! noro 2487: ND_pairs update_pairs_s(ND_pairs d,NODE g,int t,NODE *syz);
! 2488: ND_pairs nd_newpairs_s( NODE g, int t ,NODE *syz);
1.24 noro 2489:
2490: int nd_nf_pbucket_s(int mod,ND g,NDV *ps,int full,ND *nf);
2491: int nd_nf_s(int mod,ND d,ND g,NDV *ps,int full,ND *nf);
2492:
2493: void _copydl(int n,DL d1,DL d2);
2494: void _subfromdl(int n,DL d1,DL d2);
2495: extern int (*cmpdl)(int n,DL d1,DL d2);
2496:
2497: NODE insert_sig(NODE l,SIG s)
2498: {
2499: int pos;
2500: DL sig;
2501: struct oNODE root;
2502: NODE p,prev,r;
2503: SIG t;
2504:
2505: pos = s->pos; sig = DL(s);
2506: root.next = l; prev = &root;
2507: for ( p = l; p; p = p->next ) {
2508: t = (SIG)p->body;
2509: if ( t->pos == pos ) {
2510: if ( _dl_redble(DL(t),sig,nd_nvar) )
2511: return root.next;
2512: else if ( _dl_redble(sig,DL(t),nd_nvar) )
2513: // remove p
2514: prev->next = p->next;
2515: } else
2516: prev = p;
2517: }
1.27 noro 2518: NEWNODE(r); r->body = (pointer)s; r->next = 0;
2519: for ( p = &root; p->next; p = p->next );
2520: p->next = r;
2521: // r->next = root.next;
2522: // return r;
2523: return root.next;
1.24 noro 2524: }
2525:
2526: ND_pairs remove_spair_s(ND_pairs d,SIG sig)
2527: {
2528: struct oND_pairs root;
2529: ND_pairs prev,p;
2530: SIG spsig;
2531:
2532: root.next = d;
2533: prev = &root; p = d;
2534: while ( p ) {
2535: spsig = p->sig;
1.26 noro 2536: if ( sig->pos == spsig->pos && _dl_redble(DL(sig),DL(spsig),nd_nvar) ) {
1.24 noro 2537: // remove p
2538: prev->next = p->next;
1.26 noro 2539: Nsyz++;
2540: } else
1.24 noro 2541: prev = p;
2542: p = p->next;
2543: }
2544: return (ND_pairs)root.next;
2545: }
2546:
1.29 ! noro 2547: int _dl_redble_ext(DL,DL,DL,int);
! 2548:
1.28 noro 2549: int small_lcm(ND_pairs l)
2550: {
2551: SIG sig;
2552: int i;
1.29 ! noro 2553: NODE t;
1.28 noro 2554: static DL lcm,mul,quo;
2555: static int nvar;
2556:
2557: if ( nvar < nd_nvar ) {
2558: nvar = nd_nvar; NEWDL(lcm,nvar); NEWDL(quo,nvar); NEWDL(mul,nvar);
2559: }
2560: sig = l->sig;
2561: _ndltodl(l->lcm,lcm);
1.29 ! noro 2562: #if 0
1.28 noro 2563: for ( i = 0; i < nd_psn; i++ ) {
2564: if ( sig->pos == nd_psh[i]->sig->pos &&
1.29 ! noro 2565: _dl_redble_ext(DL(nd_psh[i]->sig),DL(sig),quo,nd_nvar) ) {
1.28 noro 2566: _ndltodl(DL(nd_psh[i]),mul);
2567: _addtodl(nd_nvar,quo,mul);
2568: if ( (*cmpdl)(nd_nvar,lcm,mul) > 0 )
2569: break;
2570: }
2571: }
2572: if ( i < nd_psn ) return 1;
2573: else return 0;
1.29 ! noro 2574: #else
! 2575: for ( t = nd_sba_pos[sig->pos]; t; t = t->next ) {
! 2576: i = (long)BDY(t);
! 2577: if ( _dl_redble_ext(DL(nd_psh[i]->sig),DL(sig),quo,nd_nvar) ) {
! 2578: _ndltodl(DL(nd_psh[i]),mul);
! 2579: _addtodl(nd_nvar,quo,mul);
! 2580: if ( (*cmpdl)(nd_nvar,lcm,mul) > 0 )
! 2581: break;
! 2582: }
! 2583: }
! 2584: if ( t ) return 1;
! 2585: else return 0;
! 2586: #endif
1.28 noro 2587: }
2588:
2589: ND_pairs remove_large_lcm(ND_pairs d)
2590: {
2591: struct oND_pairs root;
2592: ND_pairs prev,p;
2593:
2594: root.next = d;
2595: prev = &root; p = d;
2596: while ( p ) {
2597: if ( small_lcm(p) ) {
2598: // remove p
2599: prev->next = p->next;
2600: } else
2601: prev = p;
2602: p = p->next;
2603: }
2604: return (ND_pairs)root.next;
2605: }
2606:
1.26 noro 2607: struct oEGT eg_create,eg_newpairs,eg_merge;
2608:
1.24 noro 2609: NODE nd_sba_buch(int m,int ishomo,int **indp)
2610: {
1.29 ! noro 2611: int i,j,nh,sugar,stat;
1.24 noro 2612: NODE r,g,t;
2613: ND_pairs d;
2614: ND_pairs l;
2615: ND h,nf,s,head,nf1;
2616: NDV nfv;
2617: Z q;
2618: union oNDC dn,hc;
2619: P cont;
2620: LIST list;
2621: SIG sig;
1.29 ! noro 2622: NODE *syzlist;
1.26 noro 2623: int Nredundant;
1.28 noro 2624: DL lcm,quo,mul;
1.29 ! noro 2625: struct oEGT eg1,eg2,eg_update,eg_remove,eg_large;
1.24 noro 2626:
1.27 noro 2627: init_eg(&eg_remove);
1.29 ! noro 2628: syzlist = (NODE *)MALLOC(nd_psn*sizeof(NODE));
1.26 noro 2629: Nsyz = 0;
1.24 noro 2630: Nnd_add = 0;
1.26 noro 2631: Nredundant = 0;
1.24 noro 2632: g = 0; d = 0;
2633: for ( i = 0; i < nd_psn; i++ ) {
1.29 ! noro 2634: d = update_pairs_s(d,g,i,syzlist);
1.24 noro 2635: g = append_one(g,i);
2636: }
1.29 ! noro 2637: for ( i = 0; i < nd_psn; i++ )
! 2638: for ( j = i+1; j < nd_psn; j++ ) {
! 2639: NEWSIG(sig); sig->pos = j;
! 2640: _copydl(nd_nvar,nd_sba_hm[i],sig->dl);
! 2641: syzlist[sig->pos] = insert_sig(syzlist[sig->pos],sig);
! 2642: }
1.24 noro 2643: sugar = 0;
1.26 noro 2644: NEWDL(lcm,nd_nvar); NEWDL(quo,nd_nvar); NEWDL(mul,nd_nvar);
2645: init_eg(&eg_create);
2646: init_eg(&eg_merge);
1.29 ! noro 2647: init_eg(&eg_large);
1.24 noro 2648: while ( d ) {
2649: again:
1.26 noro 2650: if ( DP_Print ) {
2651: int len;
2652: ND_pairs td;
1.28 noro 2653: for ( td = d, len=0; td; td = td->next, len++)
2654: ;
1.26 noro 2655: if ( !(len%100) ) fprintf(asir_out,"(%d)",len);
2656: }
1.24 noro 2657: l = d; d = d->next;
1.28 noro 2658: if ( small_lcm(l) ) {
1.24 noro 2659: if ( DP_Print ) fprintf(asir_out,"M");
1.26 noro 2660: Nredundant++;
1.24 noro 2661: continue;
2662: }
2663: if ( SG(l) != sugar ) {
2664: sugar = SG(l);
2665: if ( DP_Print ) fprintf(asir_out,"%d",sugar);
2666: }
1.28 noro 2667: sig = l->sig;
1.24 noro 2668: stat = nd_sp(m,0,l,&h);
2669: if ( !stat ) {
2670: NEXT(l) = d; d = l;
2671: d = nd_reconstruct(0,d);
2672: goto again;
2673: }
1.25 noro 2674: #if USE_GEOBUCKET
1.24 noro 2675: stat = m?nd_nf_pbucket_s(m,h,nd_ps,!Top,&nf):nd_nf_s(m,0,h,nd_ps,!Top,&nf);
2676: #else
2677: stat = nd_nf_s(m,0,h,nd_ps,!Top,&nf);
2678: #endif
2679: if ( !stat ) {
2680: NEXT(l) = d; d = l;
2681: d = nd_reconstruct(0,d);
2682: goto again;
2683: } else if ( stat == -1 ) {
2684: if ( DP_Print ) { printf("S"); fflush(stdout); }
1.27 noro 2685: FREENDP(l);
1.24 noro 2686: } else if ( nf ) {
2687: if ( DP_Print ) { printf("+"); fflush(stdout); }
2688: hc = HCU(nf);
2689: nd_removecont(m,nf);
2690: nfv = ndtondv(m,nf); nd_free(nf);
2691: nh = ndv_newps(m,nfv,0);
1.26 noro 2692:
1.24 noro 2693: d = update_pairs_s(d,g,nh,syzlist);
2694: g = append_one(g,nh);
1.29 ! noro 2695: nd_sba_pos[sig->pos] = append_one(nd_sba_pos[sig->pos],nh);
1.24 noro 2696: FREENDP(l);
2697: } else {
2698: // syzygy
1.27 noro 2699: get_eg(&eg1);
1.24 noro 2700: d = remove_spair_s(d,sig);
1.27 noro 2701: get_eg(&eg2); add_eg(&eg_remove,&eg1,&eg2);
1.29 ! noro 2702: syzlist[sig->pos] = insert_sig(syzlist[sig->pos],sig);
1.24 noro 2703: if ( DP_Print ) { printf("."); fflush(stdout); }
2704: FREENDP(l);
2705: }
2706: }
2707: conv_ilist(nd_demand,0,g,indp);
1.26 noro 2708: if ( DP_Print ) {
2709: printf("\nnd_sba done. nd_add=%d,Nsyz=%d,Nredundant=%d\n",Nnd_add,Nsyz,Nredundant);
2710: fflush(stdout);
2711: print_eg("create",&eg_create);
2712: print_eg("merge",&eg_merge);
1.27 noro 2713: print_eg("remove",&eg_remove);
2714: printf("\n");
1.26 noro 2715: }
1.24 noro 2716: return g;
2717: }
2718:
1.1 noro 2719: /* splist = [[i1,i2],...] */
2720:
2721: int check_splist(int m,NODE splist)
2722: {
2723: NODE t,p;
2724: ND_pairs d,r,l;
2725: int stat;
2726: ND h,nf;
2727:
2728: for ( d = 0, t = splist; t; t = NEXT(t) ) {
2729: p = BDY((LIST)BDY(t));
1.6 noro 2730: NEXTND_pairs(d,r);
2731: r->i1 = ZTOS((Q)ARG0(p)); r->i2 = ZTOS((Q)ARG1(p));
2732: ndl_lcm(DL(nd_psh[r->i1]),DL(nd_psh[r->i2]),r->lcm);
1.1 noro 2733: SG(r) = TD(LCM(r)); /* XXX */
2734: }
2735: if ( d ) NEXT(r) = 0;
2736:
1.6 noro 2737: while ( d ) {
1.1 noro 2738: again:
1.6 noro 2739: l = nd_minp(d,&d);
2740: stat = nd_sp(m,0,l,&h);
2741: if ( !stat ) {
2742: NEXT(l) = d; d = l;
2743: d = nd_reconstruct(0,d);
2744: goto again;
2745: }
2746: stat = nd_nf(m,0,h,nd_ps,!Top,&nf);
2747: if ( !stat ) {
2748: NEXT(l) = d; d = l;
2749: d = nd_reconstruct(0,d);
2750: goto again;
2751: } else if ( nf ) return 0;
1.1 noro 2752: if ( DP_Print) { printf("."); fflush(stdout); }
1.6 noro 2753: }
1.1 noro 2754: if ( DP_Print) { printf("done.\n"); fflush(stdout); }
2755: return 1;
2756: }
2757:
2758: int check_splist_f4(int m,NODE splist)
2759: {
2760: UINT *s0vect;
1.6 noro 2761: PGeoBucket bucket;
1.1 noro 2762: NODE p,rp0,t;
2763: ND_pairs d,r,l,ll;
2764: int col,stat;
2765:
2766: for ( d = 0, t = splist; t; t = NEXT(t) ) {
2767: p = BDY((LIST)BDY(t));
1.6 noro 2768: NEXTND_pairs(d,r);
2769: r->i1 = ZTOS((Q)ARG0(p)); r->i2 = ZTOS((Q)ARG1(p));
2770: ndl_lcm(DL(nd_psh[r->i1]),DL(nd_psh[r->i2]),r->lcm);
1.1 noro 2771: SG(r) = TD(LCM(r)); /* XXX */
2772: }
2773: if ( d ) NEXT(r) = 0;
2774:
1.6 noro 2775: while ( d ) {
2776: l = nd_minsugarp(d,&d);
2777: bucket = create_pbucket();
2778: stat = nd_sp_f4(m,0,l,bucket);
2779: if ( !stat ) {
2780: for ( ll = l; NEXT(ll); ll = NEXT(ll) );
2781: NEXT(ll) = d; d = l;
2782: d = nd_reconstruct(0,d);
2783: continue;
2784: }
2785: if ( bucket->m < 0 ) continue;
2786: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
2787: if ( !col ) {
2788: for ( ll = l; NEXT(ll); ll = NEXT(ll) );
2789: NEXT(ll) = d; d = l;
2790: d = nd_reconstruct(0,d);
2791: continue;
1.1 noro 2792: }
1.6 noro 2793: if ( nd_f4_red(m,l,0,s0vect,col,rp0,0) ) return 0;
2794: }
2795: return 1;
1.1 noro 2796: }
2797:
2798: int do_diagonalize_trace(int sugar,int m)
2799: {
1.6 noro 2800: int i,nh,stat;
2801: NODE r,g,t;
2802: ND h,nf,nfq,s,head;
2803: NDV nfv,nfqv;
2804: Q q,den,num;
2805: union oNDC hc;
2806: NODE node;
2807: LIST l;
2808: Z iq;
2809: P cont,cont1;
1.1 noro 2810:
1.6 noro 2811: for ( i = nd_psn-1; i >= 0 && SG(nd_psh[i]) == sugar; i-- ) {
2812: if ( nd_gentrace ) {
2813: /* Trace = [1,index,1,1] */
2814: STOZ(i,iq); node = mknode(4,ONE,iq,ONE,ONE);
2815: MKLIST(l,node); MKNODE(nd_tracelist,l,0);
2816: }
2817: /* for nd_ps */
2818: s = ndvtond(m,nd_ps[i]);
2819: s = nd_separate_head(s,&head);
2820: stat = nd_nf_pbucket(m,s,nd_ps,1,&nf);
2821: if ( !stat ) return 0;
2822: nf = nd_add(m,head,nf);
2823: ndv_free(nd_ps[i]);
2824: nd_ps[i] = ndtondv(m,nf);
2825: nd_free(nf);
2826:
2827: /* for nd_ps_trace */
2828: if ( nd_demand )
2829: nfv = ndv_load(i);
2830: else
2831: nfv = nd_ps_trace[i];
2832: s = ndvtond(0,nfv);
2833: s = nd_separate_head(s,&head);
2834: stat = nd_nf(0,head,s,nd_ps_trace,1,&nf);
2835: if ( !stat ) return 0;
2836: ndv_free(nfv);
2837: hc = HCU(nf); nd_removecont(0,nf);
2838: /* exact division */
1.1 noro 2839: cont = ndc_div(0,hc,HCU(nf));
1.6 noro 2840: if ( nd_gentrace ) finalize_tracelist(i,cont);
2841: nfv = ndtondv(0,nf);
2842: nd_free(nf);
2843: nd_bound[i] = ndv_compute_bound(nfv);
2844: register_hcf(nfv);
2845: if ( nd_demand ) {
2846: ndv_save(nfv,i);
2847: ndv_free(nfv);
2848: } else
2849: nd_ps_trace[i] = nfv;
2850: }
2851: return 1;
1.1 noro 2852: }
2853:
2854: static struct oEGT eg_invdalg;
2855: struct oEGT eg_le;
2856:
2857: void nd_subst_vector(VL vl,P p,NODE subst,P *r)
2858: {
2859: NODE tn;
2860: P p1;
2861:
2862: for ( tn = subst; tn; tn = NEXT(NEXT(tn)) ) {
2863: substp(vl,p,BDY(tn),BDY(NEXT(tn)),&p1); p = p1;
2864: }
2865: *r = p;
2866: }
2867:
2868: NODE nd_gb_trace(int m,int ishomo,int **indp)
2869: {
1.6 noro 2870: int i,nh,sugar,stat;
2871: NODE r,g,t;
2872: ND_pairs d;
2873: ND_pairs l;
2874: ND h,nf,nfq,s,head;
2875: NDV nfv,nfqv;
2876: Z q,den,num;
2877: P hc;
2878: union oNDC dn,hnfq;
2879: struct oEGT eg_monic,egm0,egm1;
2880: int diag_count = 0;
2881: P cont;
2882: LIST list;
2883:
2884: init_eg(&eg_monic);
2885: init_eg(&eg_invdalg);
2886: init_eg(&eg_le);
2887: g = 0; d = 0;
2888: for ( i = 0; i < nd_psn; i++ ) {
2889: d = update_pairs(d,g,i,0);
2890: g = update_base(g,i);
2891: }
2892: sugar = 0;
2893: while ( d ) {
1.1 noro 2894: again:
1.6 noro 2895: l = nd_minp(d,&d);
2896: if ( MaxDeg > 0 && SG(l) > MaxDeg ) break;
2897: if ( SG(l) != sugar ) {
1.1 noro 2898: #if 1
1.6 noro 2899: if ( ishomo ) {
2900: if ( DP_Print > 2 ) fprintf(asir_out,"|");
2901: stat = do_diagonalize_trace(sugar,m);
2902: if ( DP_Print > 2 ) fprintf(asir_out,"|");
2903: diag_count = 0;
1.1 noro 2904: if ( !stat ) {
1.6 noro 2905: NEXT(l) = d; d = l;
2906: d = nd_reconstruct(1,d);
2907: goto again;
1.1 noro 2908: }
1.6 noro 2909: }
2910: #endif
2911: sugar = SG(l);
2912: if ( DP_Print ) fprintf(asir_out,"%d",sugar);
2913: }
2914: stat = nd_sp(m,0,l,&h);
2915: if ( !stat ) {
2916: NEXT(l) = d; d = l;
2917: d = nd_reconstruct(1,d);
2918: goto again;
2919: }
1.1 noro 2920: #if USE_GEOBUCKET
1.6 noro 2921: stat = nd_nf_pbucket(m,h,nd_ps,!Top,&nf);
1.1 noro 2922: #else
1.6 noro 2923: stat = nd_nf(m,0,h,nd_ps,!Top,&nf);
1.1 noro 2924: #endif
1.6 noro 2925: if ( !stat ) {
2926: NEXT(l) = d; d = l;
2927: d = nd_reconstruct(1,d);
2928: goto again;
2929: } else if ( nf ) {
2930: if ( nd_demand ) {
2931: nfqv = ndv_load(nd_psn);
2932: nfq = ndvtond(0,nfqv);
2933: } else
2934: nfq = 0;
2935: if ( !nfq ) {
2936: if ( !nd_sp(0,1,l,&h) || !nd_nf(0,0,h,nd_ps_trace,!Top,&nfq) ) {
2937: NEXT(l) = d; d = l;
2938: d = nd_reconstruct(1,d);
2939: goto again;
2940: }
2941: }
2942: if ( nfq ) {
2943: /* m|HC(nfq) => failure */
2944: if ( nd_vc ) {
2945: nd_subst_vector(nd_vc,HCP(nfq),nd_subst,&hc); q = (Z)hc;
2946: } else
2947: q = HCZ(nfq);
2948: if ( !remqi((Q)q,m) ) return 0;
2949:
2950: if ( DP_Print ) { printf("+"); fflush(stdout); }
2951: hnfq = HCU(nfq);
2952: if ( nd_nalg ) {
2953: /* m|DN(HC(nf)^(-1)) => failure */
2954: get_eg(&egm0);
2955: if ( !nd_monic(m,&nfq) ) return 0;
2956: get_eg(&egm1); add_eg(&eg_monic,&egm0,&egm1);
2957: nd_removecont(0,nfq); nfqv = ndtondv(0,nfq); nd_free(nfq);
2958: nfv = ndv_dup(0,nfqv); ndv_mod(m,nfv); nd_free(nf);
2959: } else {
2960: nd_removecont(0,nfq); nfqv = ndtondv(0,nfq); nd_free(nfq);
2961: nd_removecont(m,nf); nfv = ndtondv(m,nf); nd_free(nf);
2962: }
2963: if ( nd_gentrace ) {
2964: /* exact division */
2965: cont = ndc_div(0,hnfq,HCU(nfqv));
2966: if ( !UNIQ(cont) ) {
2967: t = mknode(4,NULLP,NULLP,NULLP,cont);
2968: MKLIST(list,t); MKNODE(t,list,nd_tracelist);
2969: nd_tracelist = t;
2970: }
2971: }
1.24 noro 2972: nh = ndv_newps(0,nfv,nfqv);
1.6 noro 2973: if ( ishomo && ++diag_count == diag_period ) {
2974: diag_count = 0;
2975: if ( DP_Print > 2 ) fprintf(asir_out,"|");
2976: stat = do_diagonalize_trace(sugar,m);
2977: if ( DP_Print > 2 ) fprintf(asir_out,"|");
2978: if ( !stat ) {
1.1 noro 2979: NEXT(l) = d; d = l;
2980: d = nd_reconstruct(1,d);
2981: goto again;
1.6 noro 2982: }
1.1 noro 2983: }
1.6 noro 2984: d = update_pairs(d,g,nh,0);
2985: g = update_base(g,nh);
2986: } else {
2987: if ( DP_Print ) { printf("*"); fflush(stdout); }
2988: }
2989: } else {
2990: if ( DP_Print ) { printf("."); fflush(stdout); }
1.1 noro 2991: }
1.6 noro 2992: FREENDP(l);
2993: }
2994: if ( nd_nalg ) {
2995: if ( DP_Print ) {
2996: print_eg("monic",&eg_monic);
2997: print_eg("invdalg",&eg_invdalg);
2998: print_eg("le",&eg_le);
1.1 noro 2999: }
1.6 noro 3000: }
1.1 noro 3001: conv_ilist(nd_demand,1,g,indp);
1.6 noro 3002: if ( DP_Print ) { printf("nd_gb_trace done.\n"); fflush(stdout); }
3003: return g;
1.1 noro 3004: }
3005:
3006: int ndv_compare(NDV *p1,NDV *p2)
3007: {
3008: return DL_COMPARE(HDL(*p1),HDL(*p2));
3009: }
3010:
3011: int ndv_compare_rev(NDV *p1,NDV *p2)
3012: {
3013: return -DL_COMPARE(HDL(*p1),HDL(*p2));
3014: }
3015:
3016: int ndvi_compare(NDVI p1,NDVI p2)
3017: {
3018: return DL_COMPARE(HDL(p1->p),HDL(p2->p));
3019: }
3020:
3021: int ndvi_compare_rev(NDVI p1,NDVI p2)
3022: {
3023: return -DL_COMPARE(HDL(p1->p),HDL(p2->p));
3024: }
3025:
3026: NODE ndv_reduceall(int m,NODE f)
3027: {
3028: int i,j,n,stat;
3029: ND nf,g,head;
3030: NODE t,a0,a;
3031: union oNDC dn;
3032: Q q,num,den;
3033: NODE node;
3034: LIST l;
3035: Z iq,jq;
3036: int *perm;
3037: union oNDC hc;
3038: P cont,cont1;
3039:
3040: if ( nd_nora ) return f;
3041: n = length(f);
1.24 noro 3042: ndv_setup(m,0,f,0,1,0);
1.1 noro 3043: perm = (int *)MALLOC(n*sizeof(int));
3044: if ( nd_gentrace ) {
3045: for ( t = nd_tracelist, i = 0; i < n; i++, t = NEXT(t) )
1.6 noro 3046: perm[i] = ZTOS((Q)ARG1(BDY((LIST)BDY(t))));
1.1 noro 3047: }
3048: for ( i = 0; i < n; ) {
3049: if ( nd_gentrace ) {
3050: /* Trace = [1,index,1,1] */
1.6 noro 3051: STOZ(i,iq); node = mknode(4,ONE,iq,ONE,ONE);
1.1 noro 3052: MKLIST(l,node); MKNODE(nd_tracelist,l,0);
3053: }
3054: g = ndvtond(m,nd_ps[i]);
3055: g = nd_separate_head(g,&head);
1.6 noro 3056: stat = nd_nf(m,head,g,nd_ps,1,&nf);
1.1 noro 3057: if ( !stat )
3058: nd_reconstruct(0,0);
3059: else {
3060: if ( DP_Print ) { printf("."); fflush(stdout); }
3061: ndv_free(nd_ps[i]);
3062: hc = HCU(nf); nd_removecont(m,nf);
3063: if ( nd_gentrace ) {
3064: for ( t = nd_tracelist; t; t = NEXT(t) ) {
1.6 noro 3065: jq = ARG1(BDY((LIST)BDY(t))); j = ZTOS(jq);
3066: STOZ(perm[j],jq); ARG1(BDY((LIST)BDY(t))) = jq;
1.1 noro 3067: }
1.6 noro 3068: /* exact division */
1.1 noro 3069: cont = ndc_div(m,hc,HCU(nf));
3070: finalize_tracelist(perm[i],cont);
3071: }
3072: nd_ps[i] = ndtondv(m,nf); nd_free(nf);
3073: nd_bound[i] = ndv_compute_bound(nd_ps[i]);
3074: i++;
3075: }
3076: }
3077: if ( DP_Print ) { printf("\n"); }
3078: for ( a0 = 0, i = 0; i < n; i++ ) {
3079: NEXTNODE(a0,a);
3080: if ( !nd_gentrace ) BDY(a) = (pointer)nd_ps[i];
3081: else {
3082: for ( j = 0; j < n; j++ ) if ( perm[j] == i ) break;
3083: BDY(a) = (pointer)nd_ps[j];
3084: }
3085: }
3086: NEXT(a) = 0;
3087: return a0;
3088: }
3089:
3090: ND_pairs update_pairs( ND_pairs d, NODE /* of index */ g, int t, int gensyz)
3091: {
3092: ND_pairs d1,nd,cur,head,prev,remove;
3093:
3094: if ( !g ) return d;
3095: /* for testing */
3096: if ( gensyz && nd_gensyz == 2 ) {
3097: d1 = nd_newpairs(g,t);
3098: if ( !d )
3099: return d1;
3100: else {
3101: nd = d;
3102: while ( NEXT(nd) ) nd = NEXT(nd);
3103: NEXT(nd) = d1;
3104: return d;
3105: }
3106: }
3107: d = crit_B(d,t);
3108: d1 = nd_newpairs(g,t);
3109: d1 = crit_M(d1);
3110: d1 = crit_F(d1);
3111: if ( gensyz || do_weyl )
3112: head = d1;
3113: else {
3114: prev = 0; cur = head = d1;
3115: while ( cur ) {
3116: if ( crit_2( cur->i1,cur->i2 ) ) {
3117: remove = cur;
3118: if ( !prev ) head = cur = NEXT(cur);
3119: else cur = NEXT(prev) = NEXT(cur);
3120: FREENDP(remove);
3121: } else {
3122: prev = cur; cur = NEXT(cur);
3123: }
3124: }
3125: }
3126: if ( !d )
3127: return head;
3128: else {
3129: nd = d;
3130: while ( NEXT(nd) ) nd = NEXT(nd);
3131: NEXT(nd) = head;
3132: return d;
3133: }
3134: }
3135:
1.24 noro 3136: ND_pairs merge_pairs_s(ND_pairs d,ND_pairs d1);
3137:
1.29 ! noro 3138: ND_pairs update_pairs_s( ND_pairs d, NODE /* of index */ g, int t,NODE *syz)
1.24 noro 3139: {
3140: ND_pairs d1;
1.26 noro 3141: struct oEGT eg1,eg2,eg3;
1.24 noro 3142:
3143: if ( !g ) return d;
1.26 noro 3144: get_eg(&eg1);
1.24 noro 3145: d1 = nd_newpairs_s(g,t,syz);
1.26 noro 3146: get_eg(&eg2); add_eg(&eg_create,&eg1,&eg2);
1.24 noro 3147: d = merge_pairs_s(d,d1);
1.26 noro 3148: get_eg(&eg3); add_eg(&eg_merge,&eg2,&eg3);
1.24 noro 3149: return d;
3150: }
1.1 noro 3151:
3152: ND_pairs nd_newpairs( NODE g, int t )
3153: {
3154: NODE h;
3155: UINT *dl;
3156: int ts,s,i,t0,min,max;
3157: ND_pairs r,r0;
3158:
3159: dl = DL(nd_psh[t]);
3160: ts = SG(nd_psh[t]) - TD(dl);
1.17 noro 3161: if ( nd_module && nd_intersect && (MPOS(dl) > nd_intersect) ) return 0;
1.1 noro 3162: for ( r0 = 0, h = g; h; h = NEXT(h) ) {
3163: if ( nd_module && (MPOS(DL(nd_psh[(long)BDY(h)])) != MPOS(dl)) )
3164: continue;
3165: if ( nd_gbblock ) {
3166: t0 = (long)BDY(h);
3167: for ( i = 0; nd_gbblock[i] >= 0; i += 2 ) {
3168: min = nd_gbblock[i]; max = nd_gbblock[i+1];
3169: if ( t0 >= min && t0 <= max && t >= min && t <= max )
3170: break;
3171: }
3172: if ( nd_gbblock[i] >= 0 )
3173: continue;
3174: }
3175: NEXTND_pairs(r0,r);
3176: r->i1 = (long)BDY(h);
3177: r->i2 = t;
3178: ndl_lcm(DL(nd_psh[r->i1]),dl,r->lcm);
3179: s = SG(nd_psh[r->i1])-TD(DL(nd_psh[r->i1]));
3180: SG(r) = MAX(s,ts) + TD(LCM(r));
3181: /* experimental */
3182: if ( nd_sugarweight )
3183: r->sugar2 = ndl_weight2(r->lcm);
3184: }
3185: if ( r0 ) NEXT(r) = 0;
3186: return r0;
3187: }
3188:
1.24 noro 3189:
3190: int comp_sig(SIG s1,SIG s2)
3191: {
3192: #if 0
3193: if ( s1->pos > s2->pos ) return 1;
3194: else if ( s1->pos < s2->pos ) return -1;
3195: else return (*cmpdl)(nd_nvar,s1->dl,s2->dl);
3196: #else
3197: static DL m1,m2;
3198: static int nvar;
3199: int ret;
3200:
1.26 noro 3201: if ( nvar != nd_nvar ) {
3202: nvar = nd_nvar; NEWDL(m1,nvar); NEWDL(m2,nvar);
1.24 noro 3203: }
1.27 noro 3204: // _ndltodl(DL(nd_psh[s1->pos]),m1);
3205: // _ndltodl(DL(nd_psh[s2->pos]),m2);
3206: _copydl(nd_nvar,nd_sba_hm[s1->pos],m1);
3207: _copydl(nd_nvar,nd_sba_hm[s2->pos],m2);
1.24 noro 3208: _addtodl(nd_nvar,s1->dl,m1);
3209: _addtodl(nd_nvar,s2->dl,m2);
3210: ret = (*cmpdl)(nd_nvar,m1,m2);
3211: if ( ret != 0 ) return ret;
3212: else if ( s1->pos > s2->pos ) return 1;
3213: else if ( s1->pos < s2->pos ) return -1;
3214: else return 0;
3215: #endif
3216: }
3217:
3218: int _create_spair_s(int i1,int i2,ND_pairs sp,SIG sig1,SIG sig2)
3219: {
3220: int ret,s1,s2;
3221: RHist p1,p2;
3222: static int wpd;
3223: static UINT *lcm;
3224:
3225: sp->i1 = i1;
3226: sp->i2 = i2;
3227: p1 = nd_psh[i1];
3228: p2 = nd_psh[i2];
3229: ndl_lcm(DL(p1),DL(p2),sp->lcm);
3230: s1 = SG(p1)-TD(DL(p1));
3231: s2 = SG(p2)-TD(DL(p2));
3232: SG(sp) = MAX(s1,s2) + TD(sp->lcm);
3233:
1.26 noro 3234: if ( wpd != nd_wpd ) {
1.24 noro 3235: wpd = nd_wpd;
3236: lcm = (UINT *)MALLOC(wpd*sizeof(UINT));
3237: }
3238: // DL(sig1) <- sp->lcm
3239: // DL(sig1) -= DL(p1)
3240: // DL(sig1) += DL(p1->sig)
1.27 noro 3241: ndl_sub(sp->lcm,DL(p1),lcm);
1.24 noro 3242: _ndltodl(lcm,DL(sig1));
3243: _addtodl(nd_nvar,DL(p1->sig),DL(sig1));
3244: sig1->pos = p1->sig->pos;
3245:
3246: // DL(sig2) <- sp->lcm
3247: // DL(sig2) -= DL(p2)
3248: // DL(sig2) += DL(p2->sig)
1.27 noro 3249: ndl_sub(sp->lcm,DL(p2),lcm);
1.24 noro 3250: _ndltodl(lcm,DL(sig2));
3251: _addtodl(nd_nvar,DL(p2->sig),DL(sig2));
3252: sig2->pos = p2->sig->pos;
3253:
3254: ret = comp_sig(sig1,sig2);
3255: if ( ret == 0 ) return 0;
3256: else if ( ret > 0 ) sp->sig = sig1;
3257: else sp->sig = sig2;
3258: return 1;
3259: }
3260:
3261: SIG dup_sig(SIG sig)
3262: {
3263: SIG r;
3264:
3265: if ( !sig ) return 0;
3266: else {
3267: NEWSIG(r);
3268: _copydl(nd_nvar,DL(sig),DL(r));
3269: r->pos = sig->pos;
3270: return r;
3271: }
3272: }
3273:
3274: void dup_ND_pairs(ND_pairs to,ND_pairs from)
3275: {
3276: to->i1 = from->i1;
3277: to->i2 = from->i2;
3278: to->sugar = from->sugar;
3279: to->sugar2 = from->sugar2;
3280: ndl_copy(from->lcm,to->lcm);
3281: to->sig = dup_sig(from->sig);
3282: }
3283:
3284: ND_pairs merge_pairs_s(ND_pairs p1,ND_pairs p2)
3285: {
3286: struct oND_pairs root;
3287: ND_pairs q1,q2,r0,r;
3288: int ret;
3289:
3290: r = &root;
3291: for ( q1 = p1, q2 = p2; q1 != 0 && q2 != 0; ) {
3292: ret = comp_sig(q1->sig,q2->sig);
3293: if ( ret < 0 ) {
3294: r->next = q1; r = q1; q1 = q1->next;
3295: } else if ( ret > 0 ) {
3296: r->next = q2; r = q2; q2 = q2->next;
3297: } else {
3298: ret = DL_COMPARE(q1->lcm,q2->lcm);
3299: if ( ret < 0 ) {
3300: r->next = q1; r = q1; q1 = q1->next;
3301: q2 = q2->next;
3302: } else {
3303: r->next = q2; r = q2; q2 = q2->next;
3304: q1 = q1->next;
3305: }
3306: }
3307: }
3308: if ( q1 ) {
3309: r->next = q1;
3310: } else {
3311: r->next = q2;
3312: }
3313: return root.next;
3314: }
3315:
3316: ND_pairs insert_pair_s(ND_pairs l,ND_pairs s)
3317: {
3318: ND_pairs p,prev;
3319: int ret;
3320:
3321: for ( p = l, prev = 0; p != 0; prev = p, p = p->next ) {
3322: if ( (ret = comp_sig(s->sig,p->sig)) <= 0 )
3323: break;
3324: }
3325: if ( ret == 0 ) {
3326: ret = DL_COMPARE(s->lcm,p->lcm);
3327: if ( ret < 0 ) {
3328: // replace p with s
3329: s->next = p->next;
3330: if ( prev == 0 ) {
3331: return s;
3332: } else {
3333: prev->next = s;
3334: return l;
3335: }
3336: } else
3337: return l;
3338: } else {
3339: // insert s between prev and p
3340: s->next = p;
3341: if ( prev == 0 ) {
3342: return s;
3343: } else {
3344: prev->next = s;
3345: return l;
3346: }
3347: }
3348: }
3349:
1.29 ! noro 3350: INLINE int __dl_redble(DL d1,DL d2,int nvar)
! 3351: {
! 3352: int i;
! 3353:
! 3354: if ( d1->td > d2->td )
! 3355: return 0;
! 3356: for ( i = nvar-1; i >= 0; i-- )
! 3357: if ( d1->d[i] > d2->d[i] )
! 3358: break;
! 3359: if ( i >= 0 )
! 3360: return 0;
! 3361: else
! 3362: return 1;
! 3363: }
! 3364:
! 3365: ND_pairs nd_newpairs_s( NODE g, int t, NODE *syz)
1.24 noro 3366: {
3367: NODE h,s;
3368: UINT *dl;
1.27 noro 3369: int ts,ret,i;
1.24 noro 3370: ND_pairs r,r0,_sp,sp;
1.29 ! noro 3371: SIG spsig,tsig;
! 3372: static int nvar;
! 3373: static SIG _sig1,_sig2;
1.26 noro 3374: struct oEGT eg1,eg2,eg3,eg4;
1.24 noro 3375:
3376: NEWND_pairs(_sp);
1.29 ! noro 3377: if ( !_sig1 || nvar != nd_nvar ) {
! 3378: nvar = nd_nvar; NEWSIG(_sig1); NEWSIG(_sig2);
! 3379: }
1.24 noro 3380: r0 = 0;
1.27 noro 3381: for ( i = 0; i < t; i++ ) {
3382: ret = _create_spair_s(i,t,_sp,_sig1,_sig2);
3383: // for ( h = g; h; h = NEXT(h) ) {
3384: // ret = _create_spair_s((long)BDY(h),t,_sp,_sig1,_sig2);
1.24 noro 3385: if ( ret ) {
3386: spsig = _sp->sig;
1.29 ! noro 3387: for ( s = syz[spsig->pos]; s; s = s->next ) {
1.24 noro 3388: tsig = (SIG)s->body;
1.29 ! noro 3389: if ( _dl_redble(DL(tsig),DL(spsig),nd_nvar) )
1.24 noro 3390: break;
3391: }
3392: if ( s == 0 ) {
3393: NEWND_pairs(sp);
3394: dup_ND_pairs(sp,_sp);
3395: r0 = insert_pair_s(r0,sp);
1.26 noro 3396: } else
3397: Nsyz++;
1.24 noro 3398: }
3399: }
3400: return r0;
3401: }
3402:
1.1 noro 3403: /* ipair = [i1,i2],[i1,i2],... */
3404: ND_pairs nd_ipairtospair(NODE ipair)
3405: {
3406: int s1,s2;
3407: NODE tn,t;
3408: ND_pairs r,r0;
3409:
3410: for ( r0 = 0, t = ipair; t; t = NEXT(t) ) {
3411: NEXTND_pairs(r0,r);
3412: tn = BDY((LIST)BDY(t));
1.6 noro 3413: r->i1 = ZTOS((Q)ARG0(tn));
3414: r->i2 = ZTOS((Q)ARG1(tn));
1.1 noro 3415: ndl_lcm(DL(nd_psh[r->i1]),DL(nd_psh[r->i2]),r->lcm);
3416: s1 = SG(nd_psh[r->i1])-TD(DL(nd_psh[r->i1]));
3417: s2 = SG(nd_psh[r->i2])-TD(DL(nd_psh[r->i2]));
3418: SG(r) = MAX(s1,s2) + TD(LCM(r));
3419: /* experimental */
3420: if ( nd_sugarweight )
3421: r->sugar2 = ndl_weight2(r->lcm);
3422: }
3423: if ( r0 ) NEXT(r) = 0;
3424: return r0;
3425: }
3426:
3427: /* kokokara */
3428:
3429: ND_pairs crit_B( ND_pairs d, int s )
3430: {
3431: ND_pairs cur,head,prev,remove;
3432: UINT *t,*tl,*lcm;
3433: int td,tdl;
3434:
3435: if ( !d ) return 0;
3436: t = DL(nd_psh[s]);
3437: prev = 0;
3438: head = cur = d;
3439: lcm = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
3440: while ( cur ) {
3441: tl = cur->lcm;
3442: if ( ndl_reducible(tl,t) ) {
3443: ndl_lcm(DL(nd_psh[cur->i1]),t,lcm);
3444: if ( !ndl_equal(lcm,tl) ) {
3445: ndl_lcm(DL(nd_psh[cur->i2]),t,lcm);
3446: if (!ndl_equal(lcm,tl)) {
3447: remove = cur;
3448: if ( !prev ) {
3449: head = cur = NEXT(cur);
3450: } else {
3451: cur = NEXT(prev) = NEXT(cur);
3452: }
3453: FREENDP(remove);
3454: } else {
3455: prev = cur; cur = NEXT(cur);
3456: }
3457: } else {
3458: prev = cur; cur = NEXT(cur);
3459: }
3460: } else {
3461: prev = cur; cur = NEXT(cur);
3462: }
3463: }
3464: return head;
3465: }
3466:
3467: ND_pairs crit_M( ND_pairs d1 )
3468: {
3469: ND_pairs e,d2,d3,dd,p;
3470: UINT *id,*jd;
3471:
3472: if ( !d1 ) return d1;
3473: for ( dd = 0, e = d1; e; e = d3 ) {
3474: if ( !(d2 = NEXT(e)) ) {
3475: NEXT(e) = dd;
3476: return e;
3477: }
3478: id = LCM(e);
3479: for ( d3 = 0; d2; d2 = p ) {
3480: p = NEXT(d2);
3481: jd = LCM(d2);
3482: if ( ndl_equal(jd,id) )
3483: ;
3484: else if ( TD(jd) > TD(id) )
3485: if ( ndl_reducible(jd,id) ) continue;
3486: else ;
3487: else if ( ndl_reducible(id,jd) ) goto delit;
3488: NEXT(d2) = d3;
3489: d3 = d2;
3490: }
3491: NEXT(e) = dd;
3492: dd = e;
3493: continue;
3494: /**/
3495: delit: NEXT(d2) = d3;
3496: d3 = d2;
3497: for ( ; p; p = d2 ) {
3498: d2 = NEXT(p);
3499: NEXT(p) = d3;
3500: d3 = p;
3501: }
3502: FREENDP(e);
3503: }
3504: return dd;
3505: }
3506:
3507: ND_pairs crit_F( ND_pairs d1 )
3508: {
3509: ND_pairs rest, head,remove;
3510: ND_pairs last, p, r, w;
3511: int s;
3512:
3513: if ( !d1 ) return d1;
3514: for ( head = last = 0, p = d1; NEXT(p); ) {
3515: r = w = equivalent_pairs(p,&rest);
3516: s = SG(r);
3517: w = NEXT(w);
3518: while ( w ) {
3519: if ( crit_2(w->i1,w->i2) ) {
3520: r = w;
3521: w = NEXT(w);
3522: while ( w ) {
3523: remove = w;
3524: w = NEXT(w);
3525: FREENDP(remove);
3526: }
3527: break;
3528: } else if ( SG(w) < s ) {
3529: FREENDP(r);
3530: r = w;
3531: s = SG(r);
3532: w = NEXT(w);
3533: } else {
3534: remove = w;
3535: w = NEXT(w);
3536: FREENDP(remove);
3537: }
3538: }
3539: if ( last ) NEXT(last) = r;
3540: else head = r;
3541: NEXT(last = r) = 0;
3542: p = rest;
3543: if ( !p ) return head;
3544: }
3545: if ( !last ) return p;
3546: NEXT(last) = p;
3547: return head;
3548: }
3549:
3550: int crit_2( int dp1, int dp2 )
3551: {
3552: return ndl_disjoint(DL(nd_psh[dp1]),DL(nd_psh[dp2]));
3553: }
3554:
3555: ND_pairs equivalent_pairs( ND_pairs d1, ND_pairs *prest )
3556: {
3557: ND_pairs w,p,r,s;
3558: UINT *d;
3559:
3560: w = d1;
3561: d = LCM(w);
3562: s = NEXT(w);
3563: NEXT(w) = 0;
3564: for ( r = 0; s; s = p ) {
3565: p = NEXT(s);
3566: if ( ndl_equal(d,LCM(s)) ) {
3567: NEXT(s) = w; w = s;
3568: } else {
3569: NEXT(s) = r; r = s;
3570: }
3571: }
3572: *prest = r;
3573: return w;
3574: }
3575:
3576: NODE update_base(NODE nd,int ndp)
3577: {
3578: UINT *dl, *dln;
3579: NODE last, p, head;
3580:
3581: dl = DL(nd_psh[ndp]);
3582: for ( head = last = 0, p = nd; p; ) {
3583: dln = DL(nd_psh[(long)BDY(p)]);
3584: if ( ndl_reducible( dln, dl ) ) {
3585: p = NEXT(p);
3586: if ( last ) NEXT(last) = p;
3587: } else {
3588: if ( !last ) head = p;
3589: p = NEXT(last = p);
3590: }
3591: }
3592: head = append_one(head,ndp);
3593: return head;
3594: }
3595:
3596: ND_pairs nd_minp( ND_pairs d, ND_pairs *prest )
3597: {
3598: ND_pairs m,ml,p,l;
3599: UINT *lcm;
3600: int s,td,len,tlen,c,c1;
3601:
3602: if ( !(p = NEXT(m = d)) ) {
3603: *prest = p;
3604: NEXT(m) = 0;
3605: return m;
3606: }
3607: if ( !NoSugar ) {
3608: if ( nd_sugarweight ) {
3609: s = m->sugar2;
3610: for ( ml = 0, l = m; p; p = NEXT(l = p) )
3611: if ( (p->sugar2 < s)
3612: || ((p->sugar2 == s) && (DL_COMPARE(LCM(p),LCM(m)) < 0)) ) {
3613: ml = l; m = p; s = m->sugar2;
3614: }
3615: } else {
3616: s = SG(m);
3617: for ( ml = 0, l = m; p; p = NEXT(l = p) )
3618: if ( (SG(p) < s)
3619: || ((SG(p) == s) && (DL_COMPARE(LCM(p),LCM(m)) < 0)) ) {
3620: ml = l; m = p; s = SG(m);
3621: }
3622: }
3623: } else {
3624: for ( ml = 0, l = m; p; p = NEXT(l = p) )
3625: if ( DL_COMPARE(LCM(p),LCM(m)) < 0 ) {
3626: ml = l; m = p; s = SG(m);
3627: }
3628: }
3629: if ( !ml ) *prest = NEXT(m);
3630: else {
3631: NEXT(ml) = NEXT(m);
3632: *prest = d;
3633: }
3634: NEXT(m) = 0;
3635: return m;
3636: }
3637:
3638: ND_pairs nd_minsugarp( ND_pairs d, ND_pairs *prest )
3639: {
3640: int msugar,i;
3641: ND_pairs t,dm0,dm,dr0,dr;
3642:
3643: if ( nd_sugarweight ) {
3644: for ( msugar = d->sugar2, t = NEXT(d); t; t = NEXT(t) )
3645: if ( t->sugar2 < msugar ) msugar = t->sugar2;
3646: dm0 = 0; dr0 = 0;
3647: for ( i = 0, t = d; t; t = NEXT(t) )
3648: if ( i < nd_f4_nsp && t->sugar2 == msugar ) {
3649: if ( dm0 ) NEXT(dm) = t;
3650: else dm0 = t;
3651: dm = t;
3652: i++;
3653: } else {
3654: if ( dr0 ) NEXT(dr) = t;
3655: else dr0 = t;
3656: dr = t;
3657: }
3658: } else {
3659: for ( msugar = SG(d), t = NEXT(d); t; t = NEXT(t) )
3660: if ( SG(t) < msugar ) msugar = SG(t);
3661: dm0 = 0; dr0 = 0;
3662: for ( i = 0, t = d; t; t = NEXT(t) )
3663: if ( i < nd_f4_nsp && SG(t) == msugar ) {
3664: if ( dm0 ) NEXT(dm) = t;
3665: else dm0 = t;
3666: dm = t;
3667: i++;
3668: } else {
3669: if ( dr0 ) NEXT(dr) = t;
3670: else dr0 = t;
3671: dr = t;
3672: }
3673: }
3674: NEXT(dm) = 0;
3675: if ( dr0 ) NEXT(dr) = 0;
3676: *prest = dr0;
3677: return dm0;
3678: }
3679:
1.28 noro 3680: ND_pairs nd_minsugarp_s( ND_pairs d, ND_pairs *prest )
3681: {
3682: int msugar;
3683: ND_pairs t,last;
3684:
3685: #if 0
3686: for ( msugar = SG(d), t = d; t; t = NEXT(t) )
3687: if ( SG(t) == msugar ) last = t;
3688: #else
3689: msugar = (d->sig->dl->td)+nd_sba_hm[d->sig->pos]->td;
3690: for ( t = d; t; t = NEXT(t) )
3691: if ( ((t->sig->dl->td)+nd_sba_hm[t->sig->pos]->td) == msugar ) last = t;
3692: #endif
3693: *prest = last->next;
3694: last->next = 0;
3695: return d;
3696: }
3697:
1.1 noro 3698: int nd_tdeg(NDV c)
3699: {
3700: int wmax = 0;
3701: int i,len;
3702: NMV a;
3703:
3704: len = LEN(c);
3705: for ( a = BDY(c), i = 0; i < len; i++, NMV_ADV(a) )
3706: wmax = MAX(TD(DL(a)),wmax);
3707: return wmax;
3708: }
3709:
1.24 noro 3710: int ndv_newps(int m,NDV a,NDV aq)
1.1 noro 3711: {
3712: int len;
3713: RHist r;
3714: NDV b;
3715: NODE tn;
3716: LIST l;
3717: Z iq;
3718:
3719: if ( nd_psn == nd_pslen ) {
3720: nd_pslen *= 2;
3721: nd_ps = (NDV *)REALLOC((char *)nd_ps,nd_pslen*sizeof(NDV));
3722: nd_ps_trace = (NDV *)REALLOC((char *)nd_ps_trace,nd_pslen*sizeof(NDV));
3723: nd_psh = (RHist *)REALLOC((char *)nd_psh,nd_pslen*sizeof(RHist));
3724: nd_bound = (UINT **)
3725: REALLOC((char *)nd_bound,nd_pslen*sizeof(UINT *));
3726: nd_ps_sym = (NDV *)REALLOC((char *)nd_ps_sym,nd_pslen*sizeof(NDV));
3727: nd_ps_trace_sym = (NDV *)REALLOC((char *)nd_ps_trace_sym,nd_pslen*sizeof(NDV));
3728: }
3729: NEWRHist(r); nd_psh[nd_psn] = r;
3730: nd_ps[nd_psn] = a;
3731: if ( aq ) {
3732: nd_ps_trace[nd_psn] = aq;
3733: if ( !m ) {
3734: register_hcf(aq);
3735: } else if ( m == -2 ) {
3736: /* do nothing */
3737: } else
3738: error("ndv_newps : invalud modulus");
3739: nd_bound[nd_psn] = ndv_compute_bound(aq);
3740: #if 1
3741: SG(r) = SG(aq);
3742: #else
3743: SG(r) = nd_tdeg(aq);
3744: #endif
3745: ndl_copy(HDL(aq),DL(r));
1.24 noro 3746: r->sig = dup_sig(aq->sig);
1.1 noro 3747: } else {
3748: if ( !m ) register_hcf(a);
3749: nd_bound[nd_psn] = ndv_compute_bound(a);
3750: #if 1
3751: SG(r) = SG(a);
3752: #else
3753: SG(r) = nd_tdeg(a);
3754: #endif
3755: ndl_copy(HDL(a),DL(r));
1.24 noro 3756: r->sig = dup_sig(a->sig);
1.1 noro 3757: }
3758: if ( nd_demand ) {
3759: if ( aq ) {
3760: ndv_save(nd_ps_trace[nd_psn],nd_psn);
3761: nd_ps_sym[nd_psn] = ndv_symbolic(m,nd_ps_trace[nd_psn]);
3762: nd_ps_trace_sym[nd_psn] = ndv_symbolic(m,nd_ps_trace[nd_psn]);
3763: nd_ps_trace[nd_psn] = 0;
3764: } else {
3765: ndv_save(nd_ps[nd_psn],nd_psn);
3766: nd_ps_sym[nd_psn] = ndv_symbolic(m,nd_ps[nd_psn]);
3767: nd_ps[nd_psn] = 0;
3768: }
3769: }
3770: if ( nd_gentrace ) {
3771: /* reverse the tracelist and append it to alltracelist */
3772: nd_tracelist = reverse_node(nd_tracelist); MKLIST(l,nd_tracelist);
1.6 noro 3773: STOZ(nd_psn,iq); tn = mknode(2,iq,l); MKLIST(l,tn);
1.1 noro 3774: MKNODE(tn,l,nd_alltracelist); nd_alltracelist = tn; nd_tracelist = 0;
3775: }
3776: return nd_psn++;
3777: }
3778:
3779: /* nd_tracelist = [[0,index,div],...,[nd_psn-1,index,div]] */
3780: /* return 1 if success, 0 if failure (HC(a mod p)) */
3781:
1.24 noro 3782: int ndv_setup(int mod,int trace,NODE f,int dont_sort,int dont_removecont,int sba)
1.1 noro 3783: {
1.6 noro 3784: int i,j,td,len,max;
3785: NODE s,s0,f0,tn;
3786: UINT *d;
3787: RHist r;
3788: NDVI w;
3789: NDV a,am;
3790: union oNDC hc;
3791: NODE node;
3792: P hcp;
3793: Z iq,jq;
3794: LIST l;
3795:
3796: nd_found = 0; nd_notfirst = 0; nd_create = 0;
3797: /* initialize the tracelist */
3798: nd_tracelist = 0;
3799:
3800: for ( nd_psn = 0, s = f; s; s = NEXT(s) ) if ( BDY(s) ) nd_psn++;
3801: w = (NDVI)MALLOC(nd_psn*sizeof(struct oNDVI));
3802: for ( i = j = 0, s = f; s; s = NEXT(s), j++ )
3803: if ( BDY(s) ) { w[i].p = BDY(s); w[i].i = j; i++; }
3804: if ( !dont_sort ) {
3805: /* XXX heuristic */
1.26 noro 3806: if ( !sba && !nd_ord->id && (nd_ord->ord.simple<2) )
1.6 noro 3807: qsort(w,nd_psn,sizeof(struct oNDVI),
3808: (int (*)(const void *,const void *))ndvi_compare_rev);
3809: else
3810: qsort(w,nd_psn,sizeof(struct oNDVI),
3811: (int (*)(const void *,const void *))ndvi_compare);
3812: }
3813: nd_pslen = 2*nd_psn;
3814: nd_ps = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3815: nd_ps_trace = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3816: nd_ps_sym = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3817: nd_ps_trace_sym = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3818: nd_psh = (RHist *)MALLOC(nd_pslen*sizeof(RHist));
3819: nd_bound = (UINT **)MALLOC(nd_pslen*sizeof(UINT *));
3820: nd_hcf = 0;
1.1 noro 3821:
1.6 noro 3822: if ( trace && nd_vc )
3823: makesubst(nd_vc,&nd_subst);
3824: else
3825: nd_subst = 0;
1.1 noro 3826:
1.6 noro 3827: if ( !nd_red )
3828: nd_red = (RHist *)MALLOC(REDTAB_LEN*sizeof(RHist));
3829: for ( i = 0; i < REDTAB_LEN; i++ ) nd_red[i] = 0;
3830: for ( i = 0; i < nd_psn; i++ ) {
3831: hc = HCU(w[i].p);
3832: if ( trace ) {
3833: if ( mod == -2 ) {
3834: /* over a large finite field */
3835: /* trace = small modulus */
3836: a = nd_ps_trace[i] = ndv_dup(-2,w[i].p);
3837: ndv_mod(-2,a);
3838: if ( !dont_removecont) ndv_removecont(-2,a);
3839: am = nd_ps[i] = ndv_dup(trace,w[i].p);
3840: ndv_mod(trace,am);
3841: if ( DL_COMPARE(HDL(am),HDL(a)) )
3842: return 0;
3843: ndv_removecont(trace,am);
3844: } else {
3845: a = nd_ps_trace[i] = ndv_dup(0,w[i].p);
3846: if ( !dont_removecont) ndv_removecont(0,a);
3847: register_hcf(a);
3848: am = nd_ps[i] = ndv_dup(mod,a);
3849: ndv_mod(mod,am);
3850: if ( DL_COMPARE(HDL(am),HDL(a)) )
3851: return 0;
3852: ndv_removecont(mod,am);
3853: }
3854: } else {
3855: a = nd_ps[i] = ndv_dup(mod,w[i].p);
3856: if ( mod || !dont_removecont ) ndv_removecont(mod,a);
3857: if ( !mod ) register_hcf(a);
1.1 noro 3858: }
1.6 noro 3859: if ( nd_gentrace ) {
3860: STOZ(i,iq); STOZ(w[i].i,jq); node = mknode(3,iq,jq,ONE);
3861: /* exact division */
1.1 noro 3862: if ( !dont_removecont )
1.6 noro 3863: ARG2(node) = (pointer)ndc_div(trace?0:mod,hc,HCU(a));
3864: MKLIST(l,node); NEXTNODE(nd_tracelist,tn); BDY(tn) = l;
3865: }
3866: NEWRHist(r); SG(r) = HTD(a); ndl_copy(HDL(a),DL(r));
3867: nd_bound[i] = ndv_compute_bound(a);
3868: nd_psh[i] = r;
3869: if ( nd_demand ) {
3870: if ( trace ) {
3871: ndv_save(nd_ps_trace[i],i);
3872: nd_ps_sym[i] = ndv_symbolic(mod,nd_ps_trace[i]);
3873: nd_ps_trace_sym[i] = ndv_symbolic(mod,nd_ps_trace[i]);
3874: nd_ps_trace[i] = 0;
3875: } else {
3876: ndv_save(nd_ps[i],i);
3877: nd_ps_sym[i] = ndv_symbolic(mod,nd_ps[i]);
3878: nd_ps[i] = 0;
3879: }
1.1 noro 3880: }
1.6 noro 3881: }
1.24 noro 3882: if ( sba ) {
1.27 noro 3883: nd_sba_hm = (DL *)MALLOC(nd_psn*sizeof(DL));
1.24 noro 3884: // setup signatures
1.27 noro 3885: for ( i = 0; i < nd_psn; i++ ) {
3886: SIG sig;
1.24 noro 3887:
1.27 noro 3888: NEWSIG(sig); sig->pos = i;
3889: nd_ps[i]->sig = sig;
3890: if ( nd_demand ) nd_ps_sym[i]->sig = sig;
3891: nd_psh[i]->sig = sig;
3892: if ( trace ) {
3893: nd_ps_trace[i]->sig = sig;
3894: if ( nd_demand ) nd_ps_trace_sym[i]->sig = sig;
3895: }
3896: NEWDL(nd_sba_hm[i],nd_nvar);
3897: _ndltodl(DL(nd_psh[i]),nd_sba_hm[i]);
3898: }
1.29 ! noro 3899: nd_sba_pos = (NODE *)MALLOC(nd_psn*sizeof(NODE));
! 3900: for ( i = 0; i < nd_psn; i++ ) {
! 3901: j = nd_psh[i]->sig->pos;
! 3902: nd_sba_pos[j] = append_one(nd_sba_pos[j],i);
! 3903: }
1.24 noro 3904: }
1.6 noro 3905: if ( nd_gentrace && nd_tracelist ) NEXT(tn) = 0;
3906: return 1;
1.1 noro 3907: }
3908:
3909: struct order_spec *append_block(struct order_spec *spec,
3910: int nv,int nalg,int ord);
3911:
3912: extern VECT current_dl_weight_vector_obj;
3913: static VECT prev_weight_vector_obj;
3914:
3915: void preprocess_algcoef(VL vv,VL av,struct order_spec *ord,LIST f,
3916: struct order_spec **ord1p,LIST *f1p,NODE *alistp)
3917: {
3918: NODE alist,t,s,r0,r,arg;
3919: VL tv;
3920: P poly;
3921: DP d;
3922: Alg alpha,dp;
3923: DAlg inv,da,hc;
3924: MP m;
3925: int i,nvar,nalg,n;
3926: NumberField nf;
3927: LIST f1,f2;
3928: struct order_spec *current_spec;
3929: VECT obj,obj0;
3930: VECT tmp;
3931:
3932: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++);
3933: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++);
3934:
3935: for ( alist = 0, tv = av; tv; tv = NEXT(tv) ) {
3936: NEXTNODE(alist,t); MKV(tv->v,poly);
3937: MKAlg(poly,alpha); BDY(t) = (pointer)alpha;
3938: tv->v = tv->v->priv;
3939: }
3940: NEXT(t) = 0;
3941:
3942: /* simplification, making polynomials monic */
3943: setfield_dalg(alist);
3944: obj_algtodalg((Obj)f,(Obj *)&f1);
3945: for ( t = BDY(f); t; t = NEXT(t) ) {
3946: initd(ord); ptod(vv,vv,(P)BDY(t),&d);
3947: hc = (DAlg)BDY(d)->c;
3948: if ( NID(hc) == N_DA ) {
3949: invdalg(hc,&inv);
3950: for ( m = BDY(d); m; m = NEXT(m) ) {
3951: muldalg(inv,(DAlg)m->c,&da); m->c = (Obj)da;
3952: }
3953: }
3954: initd(ord); dtop(vv,vv,d,(Obj *)&poly); BDY(f) = (pointer)poly;
3955: }
3956: obj_dalgtoalg((Obj)f1,(Obj *)&f);
3957:
3958: /* append alg vars to the var list */
3959: for ( tv = vv; NEXT(tv); tv = NEXT(tv) );
3960: NEXT(tv) = av;
3961:
3962: /* append a block to ord */
3963: *ord1p = append_block(ord,nvar,nalg,2);
3964:
3965: /* create generator list */
3966: nf = get_numberfield();
3967: for ( i = nalg-1, t = BDY(f); i >= 0; i-- ) {
3968: MKAlg(nf->defpoly[i],dp);
3969: MKNODE(s,dp,t); t = s;
3970: }
3971: MKLIST(f1,t);
3972: *alistp = alist;
3973: algobjtorat((Obj)f1,(Obj *)f1p);
3974:
3975: /* creating a new weight vector */
3976: prev_weight_vector_obj = obj0 = current_dl_weight_vector_obj;
3977: n = nvar+nalg+1;
3978: MKVECT(obj,n);
3979: if ( obj0 && obj0->len == nvar )
3980: for ( i = 0; i < nvar; i++ ) BDY(obj)[i] = BDY(obj0)[i];
3981: else
3982: for ( i = 0; i < nvar; i++ ) BDY(obj)[i] = (pointer)ONE;
3983: for ( i = 0; i < nalg; i++ ) BDY(obj)[i+nvar] = 0;
3984: BDY(obj)[n-1] = (pointer)ONE;
3985: arg = mknode(1,obj);
3986: Pdp_set_weight(arg,&tmp);
3987: }
3988:
3989: NODE postprocess_algcoef(VL av,NODE alist,NODE r)
3990: {
3991: NODE s,t,u0,u;
3992: P p;
3993: VL tv;
3994: Obj obj;
3995: VECT tmp;
3996: NODE arg;
3997:
3998: u0 = 0;
3999: for ( t = r; t; t = NEXT(t) ) {
4000: p = (P)BDY(t);
4001: for ( tv = av, s = alist; tv; tv = NEXT(tv), s = NEXT(s) ) {
4002: substr(CO,0,(Obj)p,tv->v,(Obj)BDY(s),&obj); p = (P)obj;
4003: }
4004: if ( OID(p) == O_P || (OID(p) == O_N && NID((Num)p) != N_A) ) {
4005: NEXTNODE(u0,u);
4006: BDY(u) = (pointer)p;
4007: }
4008: }
4009: arg = mknode(1,prev_weight_vector_obj);
4010: Pdp_set_weight(arg,&tmp);
4011:
4012: return u0;
4013: }
4014:
4015: void nd_gr(LIST f,LIST v,int m,int homo,int retdp,int f4,struct order_spec *ord,LIST *rp)
4016: {
4017: VL tv,fv,vv,vc,av;
4018: NODE fd,fd0,r,r0,t,x,s,xx,alist;
4019: int e,max,nvar,i;
4020: NDV b;
4021: int ishomo,nalg,mrank,trank,wmax,len;
4022: NMV a;
4023: Alg alpha,dp;
4024: P p,zp;
4025: Q dmy;
4026: LIST f1,f2,zpl;
4027: Obj obj;
4028: NumberField nf;
4029: struct order_spec *ord1;
4030: NODE tr,tl1,tl2,tl3,tl4,nzlist;
4031: LIST l1,l2,l3,l4,l5;
4032: int j;
4033: Z jq,bpe,last_nonzero;
4034: int *perm;
4035: EPOS oepos;
4036: int obpe,oadv,ompos,cbpe;
1.15 noro 4037: VECT hvect;
1.1 noro 4038:
4039: nd_module = 0;
4040: if ( !m && Demand ) nd_demand = 1;
4041: else nd_demand = 0;
4042: parse_nd_option(current_option);
4043:
4044: if ( DP_Multiple )
4045: nd_scale = ((double)DP_Multiple)/(double)(Denominator?Denominator:1);
4046: #if 0
4047: ndv_alloc = 0;
4048: #endif
4049: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
4050: if ( m && nd_vc )
4051: error("nd_{gr,f4} : computation over Fp(X) is unsupported. Use dp_gr_mod_main().");
4052: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
4053: switch ( ord->id ) {
4054: case 1:
4055: if ( ord->nv != nvar )
4056: error("nd_{gr,f4} : invalid order specification");
4057: break;
4058: default:
4059: break;
4060: }
4061: nd_nalg = 0;
4062: av = 0;
4063: if ( !m ) {
4064: get_algtree((Obj)f,&av);
4065: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++ );
4066: nd_ntrans = nvar;
4067: nd_nalg = nalg;
4068: /* #i -> t#i */
4069: if ( nalg ) {
4070: preprocess_algcoef(vv,av,ord,f,&ord1,&f1,&alist);
4071: ord = ord1;
4072: f = f1;
4073: }
4074: nvar += nalg;
4075: }
4076: nd_init_ord(ord);
4077: mrank = 0;
4078: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
4079: for ( tv = vv; tv; tv = NEXT(tv) ) {
4080: if ( nd_module ) {
1.16 noro 4081: if ( OID(BDY(t)) == O_DPM ) {
4082: e = dpm_getdeg((DPM)BDY(t),&trank);
4083: max = MAX(e,max);
4084: mrank = MAX(mrank,trank);
4085: } else {
4086: s = BDY((LIST)BDY(t));
4087: trank = length(s);
4088: mrank = MAX(mrank,trank);
4089: for ( ; s; s = NEXT(s) ) {
4090: e = getdeg(tv->v,(P)BDY(s));
4091: max = MAX(e,max);
4092: }
1.1 noro 4093: }
4094: } else {
4095: e = getdeg(tv->v,(P)BDY(t));
4096: max = MAX(e,max);
4097: }
4098: }
4099: nd_setup_parameters(nvar,nd_nzlist?0:max);
4100: obpe = nd_bpe; oadv = nmv_adv; oepos = nd_epos; ompos = nd_mpos;
4101: ishomo = 1;
4102: for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
4103: if ( nd_module ) {
1.16 noro 4104: if ( OID(BDY(t)) == O_DPM ) {
4105: Z cont;
4106: DPM zdpm;
4107:
4108: if ( !m && !nd_gentrace ) dpm_ptozp((DPM)BDY(t),&cont,&zdpm);
4109: else zdpm = (DPM)BDY(t);
4110: b = (pointer)dpmtondv(m,zdpm);
4111: } else {
4112: if ( !m && !nd_gentrace ) pltozpl((LIST)BDY(t),&dmy,&zpl);
4113: else zpl = (LIST)BDY(t);
1.1 noro 4114: b = (pointer)pltondv(CO,vv,zpl);
1.16 noro 4115: }
1.1 noro 4116: } else {
4117: if ( !m && !nd_gentrace ) ptozp((P)BDY(t),1,&dmy,&zp);
4118: else zp = (P)BDY(t);
4119: b = (pointer)ptondv(CO,vv,zp);
4120: }
4121: if ( ishomo )
4122: ishomo = ishomo && ndv_ishomo(b);
4123: if ( m ) ndv_mod(m,b);
4124: if ( b ) { NEXTNODE(fd0,fd); BDY(fd) = (pointer)b; }
4125: }
4126: if ( fd0 ) NEXT(fd) = 0;
4127:
4128: if ( !ishomo && homo ) {
4129: for ( t = fd0, wmax = max; t; t = NEXT(t) ) {
4130: b = (NDV)BDY(t); len = LEN(b);
4131: for ( a = BDY(b), i = 0; i < len; i++, NMV_ADV(a) )
4132: wmax = MAX(TD(DL(a)),wmax);
4133: }
4134: homogenize_order(ord,nvar,&ord1);
4135: nd_init_ord(ord1);
4136: nd_setup_parameters(nvar+1,nd_nzlist?0:wmax);
4137: for ( t = fd0; t; t = NEXT(t) )
4138: ndv_homogenize((NDV)BDY(t),obpe,oadv,oepos,ompos);
4139: }
4140:
1.24 noro 4141: ndv_setup(m,0,fd0,(nd_gbblock||nd_splist||nd_check_splist)?1:0,0,0);
1.1 noro 4142: if ( nd_gentrace ) {
4143: MKLIST(l1,nd_tracelist); MKNODE(nd_alltracelist,l1,0);
4144: }
4145: if ( nd_splist ) {
4146: *rp = compute_splist();
4147: return;
4148: }
4149: if ( nd_check_splist ) {
4150: if ( f4 ) {
4151: if ( check_splist_f4(m,nd_check_splist) ) *rp = (LIST)ONE;
4152: else *rp = 0;
4153: } else {
4154: if ( check_splist(m,nd_check_splist) ) *rp = (LIST)ONE;
4155: else *rp = 0;
4156: }
4157: return;
4158: }
4159: x = f4?nd_f4(m,0,&perm):nd_gb(m,ishomo || homo,0,0,&perm);
4160: if ( !x ) {
4161: *rp = 0; return;
4162: }
1.15 noro 4163: if ( nd_gentrace ) {
4164: MKVECT(hvect,nd_psn);
4165: for ( i = 0; i < nd_psn; i++ )
4166: ndltodp(nd_psh[i]->dl,(DP *)&BDY(hvect)[i]);
4167: }
1.1 noro 4168: if ( !ishomo && homo ) {
4169: /* dehomogenization */
4170: for ( t = x; t; t = NEXT(t) ) ndv_dehomogenize((NDV)BDY(t),ord);
4171: nd_init_ord(ord);
4172: nd_setup_parameters(nvar,0);
4173: }
4174: nd_demand = 0;
4175: if ( nd_module && nd_intersect ) {
4176: for ( j = nd_psn-1, x = 0; j >= 0; j-- )
1.17 noro 4177: if ( MPOS(DL(nd_psh[j])) > nd_intersect ) {
1.1 noro 4178: MKNODE(xx,(pointer)((unsigned long)j),x); x = xx;
4179: }
4180: conv_ilist(nd_demand,0,x,0);
4181: goto FINAL;
4182: }
4183: if ( nd_gentrace && f4 ) { nzlist = nd_alltracelist; }
4184: x = ndv_reducebase(x,perm);
4185: if ( nd_gentrace && !f4 ) { tl1 = nd_alltracelist; nd_alltracelist = 0; }
4186: x = ndv_reduceall(m,x);
4187: cbpe = nd_bpe;
4188: if ( nd_gentrace && !f4 ) {
4189: tl2 = nd_alltracelist; nd_alltracelist = 0;
4190: ndv_check_membership(m,fd0,obpe,oadv,oepos,x);
4191: tl3 = nd_alltracelist; nd_alltracelist = 0;
4192: if ( nd_gensyz ) {
4193: nd_gb(m,0,1,1,0);
4194: tl4 = nd_alltracelist; nd_alltracelist = 0;
4195: } else tl4 = 0;
4196: }
4197: nd_bpe = cbpe;
4198: nd_setup_parameters(nd_nvar,0);
4199: FINAL:
4200: for ( r0 = 0, t = x; t; t = NEXT(t) ) {
1.16 noro 4201: NEXTNODE(r0,r);
4202: if ( nd_module ) {
4203: if ( retdp ) BDY(r) = ndvtodpm(m,BDY(t));
4204: else BDY(r) = ndvtopl(m,CO,vv,BDY(t),mrank);
4205: } else if ( retdp ) BDY(r) = ndvtodp(m,BDY(t));
4206: else BDY(r) = ndvtop(m,CO,vv,BDY(t));
1.1 noro 4207: }
4208: if ( r0 ) NEXT(r) = 0;
4209: if ( !m && nd_nalg )
4210: r0 = postprocess_algcoef(av,alist,r0);
4211: MKLIST(*rp,r0);
4212: if ( nd_gentrace ) {
4213: if ( f4 ) {
1.6 noro 4214: STOZ(16,bpe);
4215: STOZ(nd_last_nonzero,last_nonzero);
1.15 noro 4216: tr = mknode(6,*rp,(!ishomo&&homo)?ONE:0,BDY(nzlist),bpe,last_nonzero,hvect); MKLIST(*rp,tr);
1.1 noro 4217: } else {
4218: tl1 = reverse_node(tl1); tl2 = reverse_node(tl2);
4219: tl3 = reverse_node(tl3);
4220: /* tl2 = [[i,[[*,j,*,*],...]],...] */
4221: for ( t = tl2; t; t = NEXT(t) ) {
4222: /* s = [i,[*,j,*,*],...] */
4223: s = BDY((LIST)BDY(t));
1.6 noro 4224: j = perm[ZTOS((Q)ARG0(s))]; STOZ(j,jq); ARG0(s) = (pointer)jq;
1.1 noro 4225: for ( s = BDY((LIST)ARG1(s)); s; s = NEXT(s) ) {
1.6 noro 4226: j = perm[ZTOS((Q)ARG1(BDY((LIST)BDY(s))))]; STOZ(j,jq);
1.1 noro 4227: ARG1(BDY((LIST)BDY(s))) = (pointer)jq;
4228: }
4229: }
4230: for ( j = length(x)-1, t = 0; j >= 0; j-- ) {
1.6 noro 4231: STOZ(perm[j],jq); MKNODE(s,jq,t); t = s;
1.1 noro 4232: }
4233: MKLIST(l1,tl1); MKLIST(l2,tl2); MKLIST(l3,t); MKLIST(l4,tl3);
4234: MKLIST(l5,tl4);
1.6 noro 4235: STOZ(nd_bpe,bpe);
1.15 noro 4236: tr = mknode(9,*rp,(!ishomo&&homo)?ONE:0,l1,l2,l3,l4,l5,bpe,hvect); MKLIST(*rp,tr);
1.1 noro 4237: }
4238: }
4239: #if 0
4240: fprintf(asir_out,"ndv_alloc=%d\n",ndv_alloc);
4241: #endif
4242: }
4243:
1.28 noro 4244: NODE nd_sba_f4(int m,int **indp);
4245:
4246: void nd_sba(LIST f,LIST v,int m,int homo,int retdp,int f4,struct order_spec *ord,LIST *rp)
1.24 noro 4247: {
4248: VL tv,fv,vv,vc,av;
4249: NODE fd,fd0,r,r0,t,x,s,xx;
4250: int e,max,nvar,i;
4251: NDV b;
4252: int ishomo,nalg,wmax,len;
4253: NMV a;
4254: P p,zp;
4255: Q dmy;
4256: struct order_spec *ord1;
4257: int j;
4258: int *perm;
4259: EPOS oepos;
4260: int obpe,oadv,ompos,cbpe;
1.29 ! noro 4261: struct oEGT eg0,eg1,egconv;
1.24 noro 4262:
4263: nd_module = 0;
4264: nd_demand = 0;
4265: parse_nd_option(current_option);
4266:
4267: if ( DP_Multiple )
4268: nd_scale = ((double)DP_Multiple)/(double)(Denominator?Denominator:1);
4269: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
4270: if ( m && nd_vc )
4271: error("nd_sba : computation over Fp(X) is unsupported. Use dp_gr_mod_main().");
4272: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
4273: switch ( ord->id ) {
4274: case 1:
4275: if ( ord->nv != nvar )
4276: error("nd_sba : invalid order specification");
4277: break;
4278: default:
4279: break;
4280: }
4281: nd_nalg = 0;
4282: nd_init_ord(ord);
4283: // for SIG comparison
4284: initd(ord);
4285: for ( t = BDY(f), max = 1; t; t = NEXT(t) ) {
4286: for ( tv = vv; tv; tv = NEXT(tv) ) {
4287: e = getdeg(tv->v,(P)BDY(t));
4288: max = MAX(e,max);
4289: }
4290: }
1.25 noro 4291: nd_setup_parameters(nvar,max);
1.24 noro 4292: obpe = nd_bpe; oadv = nmv_adv; oepos = nd_epos; ompos = nd_mpos;
4293: ishomo = 1;
4294: for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
4295: if ( !m ) ptozp((P)BDY(t),1,&dmy,&zp);
4296: else zp = (P)BDY(t);
4297: b = (pointer)ptondv(CO,vv,zp);
4298: if ( ishomo )
4299: ishomo = ishomo && ndv_ishomo(b);
4300: if ( m ) ndv_mod(m,b);
4301: if ( b ) { NEXTNODE(fd0,fd); BDY(fd) = (pointer)b; }
4302: }
4303: if ( fd0 ) NEXT(fd) = 0;
4304:
4305: if ( !ishomo && homo ) {
4306: for ( t = fd0, wmax = max; t; t = NEXT(t) ) {
4307: b = (NDV)BDY(t); len = LEN(b);
4308: for ( a = BDY(b), i = 0; i < len; i++, NMV_ADV(a) )
4309: wmax = MAX(TD(DL(a)),wmax);
4310: }
4311: homogenize_order(ord,nvar,&ord1);
4312: nd_init_ord(ord1);
4313: nd_setup_parameters(nvar+1,nd_nzlist?0:wmax);
4314: for ( t = fd0; t; t = NEXT(t) )
4315: ndv_homogenize((NDV)BDY(t),obpe,oadv,oepos,ompos);
4316: }
4317:
4318: ndv_setup(m,0,fd0,0,0,1);
1.28 noro 4319: x = f4 ? nd_sba_f4(m,&perm) : nd_sba_buch(m,ishomo || homo,&perm);
1.24 noro 4320: if ( !x ) {
4321: *rp = 0; return;
4322: }
4323: if ( !ishomo && homo ) {
4324: /* dehomogenization */
4325: for ( t = x; t; t = NEXT(t) ) ndv_dehomogenize((NDV)BDY(t),ord);
4326: nd_init_ord(ord);
4327: nd_setup_parameters(nvar,0);
4328: }
4329: nd_demand = 0;
4330: x = ndv_reducebase(x,perm);
4331: x = ndv_reduceall(m,x);
4332: nd_setup_parameters(nd_nvar,0);
1.29 ! noro 4333: get_eg(&eg0);
1.24 noro 4334: for ( r0 = 0, t = x; t; t = NEXT(t) ) {
4335: NEXTNODE(r0,r);
4336: if ( retdp ) BDY(r) = ndvtodp(m,BDY(t));
4337: BDY(r) = ndvtop(m,CO,vv,BDY(t));
4338: }
4339: if ( r0 ) NEXT(r) = 0;
4340: MKLIST(*rp,r0);
1.29 ! noro 4341: get_eg(&eg1); init_eg(&egconv); add_eg(&egconv,&eg0,&eg1);
! 4342: print_eg("conv",&egconv); fprintf(asir_out,"\n");
1.24 noro 4343: }
4344:
1.1 noro 4345: void nd_gr_postproc(LIST f,LIST v,int m,struct order_spec *ord,int do_check,LIST *rp)
4346: {
4347: VL tv,fv,vv,vc,av;
4348: NODE fd,fd0,r,r0,t,x,s,xx,alist;
4349: int e,max,nvar,i;
4350: NDV b;
4351: int ishomo,nalg;
4352: Alg alpha,dp;
4353: P p,zp;
4354: Q dmy;
4355: LIST f1,f2;
4356: Obj obj;
4357: NumberField nf;
4358: struct order_spec *ord1;
4359: int *perm;
4360:
4361: parse_nd_option(current_option);
4362: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
4363: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
4364: switch ( ord->id ) {
4365: case 1:
4366: if ( ord->nv != nvar )
4367: error("nd_check : invalid order specification");
4368: break;
4369: default:
4370: break;
4371: }
4372: nd_nalg = 0;
4373: av = 0;
4374: if ( !m ) {
4375: get_algtree((Obj)f,&av);
4376: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++ );
4377: nd_ntrans = nvar;
4378: nd_nalg = nalg;
4379: /* #i -> t#i */
4380: if ( nalg ) {
4381: preprocess_algcoef(vv,av,ord,f,&ord1,&f1,&alist);
4382: ord = ord1;
4383: f = f1;
4384: }
4385: nvar += nalg;
4386: }
4387: nd_init_ord(ord);
4388: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
4389: for ( tv = vv; tv; tv = NEXT(tv) ) {
4390: e = getdeg(tv->v,(P)BDY(t));
4391: max = MAX(e,max);
4392: }
4393: nd_setup_parameters(nvar,max);
4394: ishomo = 1;
4395: for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
4396: ptozp((P)BDY(t),1,&dmy,&zp);
4397: b = (pointer)ptondv(CO,vv,zp);
4398: if ( ishomo )
4399: ishomo = ishomo && ndv_ishomo(b);
4400: if ( m ) ndv_mod(m,b);
4401: if ( b ) { NEXTNODE(fd0,fd); BDY(fd) = (pointer)b; }
4402: }
4403: if ( fd0 ) NEXT(fd) = 0;
1.24 noro 4404: ndv_setup(m,0,fd0,0,1,0);
1.1 noro 4405: for ( x = 0, i = 0; i < nd_psn; i++ )
4406: x = update_base(x,i);
4407: if ( do_check ) {
4408: x = nd_gb(m,ishomo,1,0,&perm);
4409: if ( !x ) {
4410: *rp = 0;
4411: return;
4412: }
4413: } else {
4414: #if 0
4415: /* bug ? */
4416: for ( t = x; t; t = NEXT(t) )
4417: BDY(t) = (pointer)nd_ps[(long)BDY(t)];
4418: #else
4419: conv_ilist(0,0,x,&perm);
4420: #endif
4421: }
4422: x = ndv_reducebase(x,perm);
4423: x = ndv_reduceall(m,x);
4424: for ( r0 = 0, t = x; t; t = NEXT(t) ) {
4425: NEXTNODE(r0,r);
4426: BDY(r) = ndvtop(m,CO,vv,BDY(t));
4427: }
4428: if ( r0 ) NEXT(r) = 0;
4429: if ( !m && nd_nalg )
4430: r0 = postprocess_algcoef(av,alist,r0);
4431: MKLIST(*rp,r0);
4432: }
4433:
4434: NDV recompute_trace(NODE trace,NDV *p,int m);
4435: void nd_gr_recompute_trace(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,LIST *rp);
4436:
4437: NDV recompute_trace(NODE ti,NDV *p,int mod)
4438: {
4439: int c,c1,c2,i;
4440: NM mul,m,tail;
4441: ND d,r,rm;
4442: NODE sj;
4443: NDV red;
4444: Obj mj;
4445:
4446: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
4447: CM(mul) = 1;
4448: tail = 0;
4449: for ( i = 0, d = r = 0; ti; ti = NEXT(ti), i++ ) {
4450: sj = BDY((LIST)BDY(ti));
4451: if ( ARG0(sj) ) {
1.6 noro 4452: red = p[ZTOS((Q)ARG1(sj))];
1.1 noro 4453: mj = (Obj)ARG2(sj);
4454: if ( OID(mj) != O_DP ) ndl_zero(DL(mul));
4455: else dltondl(nd_nvar,BDY((DP)mj)->dl,DL(mul));
4456: rm = ndv_mul_nm(mod,mul,red);
4457: if ( !r ) r = rm;
4458: else {
4459: for ( m = BDY(r); m && !ndl_equal(m->dl,BDY(rm)->dl); m = NEXT(m), LEN(r)-- ) {
4460: if ( d ) {
4461: NEXT(tail) = m; tail = m; LEN(d)++;
4462: } else {
4463: MKND(nd_nvar,m,1,d); tail = BDY(d);
4464: }
4465: }
4466: if ( !m ) return 0; /* failure */
4467: else {
4468: BDY(r) = m;
4469: if ( mod > 0 || mod == -1 ) {
4470: c1 = invm(HCM(rm),mod); c2 = mod-HCM(r);
4471: DMAR(c1,c2,0,mod,c);
4472: nd_mul_c(mod,rm,c);
4473: } else {
4474: Z t,u;
4475:
4476: chsgnlf(HCZ(r),&t);
4477: divlf(t,HCZ(rm),&u);
4478: nd_mul_c_lf(rm,u);
4479: }
4480: r = nd_add(mod,r,rm);
4481: }
4482: }
4483: }
4484: }
4485: if ( tail ) NEXT(tail) = 0;
4486: d = nd_add(mod,d,r);
4487: nd_mul_c(mod,d,invm(HCM(d),mod));
4488: return ndtondv(mod,d);
4489: }
4490:
4491: void nd_gr_recompute_trace(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,LIST *rp)
4492: {
4493: VL tv,fv,vv,vc,av;
4494: NODE fd,fd0,r,r0,t,x,s,xx,alist;
4495: int e,max,nvar,i;
4496: NDV b;
4497: int ishomo,nalg;
4498: Alg alpha,dp;
4499: P p,zp;
4500: Q dmy;
4501: LIST f1,f2;
4502: Obj obj;
4503: NumberField nf;
4504: struct order_spec *ord1;
4505: NODE permtrace,intred,ind,perm,trace,ti;
4506: int len,n,j;
4507: NDV *db,*pb;
4508:
4509: parse_nd_option(current_option);
4510: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
4511: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
4512: switch ( ord->id ) {
4513: case 1:
4514: if ( ord->nv != nvar )
4515: error("nd_check : invalid order specification");
4516: break;
4517: default:
4518: break;
4519: }
4520: nd_init_ord(ord);
1.6 noro 4521: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 4522: nd_setup_parameters(nvar,0);
4523:
4524: len = length(BDY(f));
4525: db = (NDV *)MALLOC(len*sizeof(NDV *));
4526: for ( i = 0, t = BDY(f); t; i++, t = NEXT(t) ) {
4527: ptozp((P)BDY(t),1,&dmy,&zp);
4528: b = ptondv(CO,vv,zp);
4529: ndv_mod(m,b);
4530: ndv_mul_c(m,b,invm(HCM(b),m));
4531: db[i] = b;
4532: }
4533:
4534: permtrace = BDY((LIST)ARG2(BDY(tlist)));
4535: intred = BDY((LIST)ARG3(BDY(tlist)));
4536: ind = BDY((LIST)ARG4(BDY(tlist)));
4537: perm = BDY((LIST)ARG0(permtrace));
4538: trace = NEXT(permtrace);
4539:
4540: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 4541: j = ZTOS((Q)ARG0(BDY((LIST)BDY(t))));
1.1 noro 4542: if ( j > i ) i = j;
4543: }
4544: n = i+1;
4545: pb = (NDV *)MALLOC(n*sizeof(NDV *));
4546: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
4547: ti = BDY((LIST)BDY(t));
1.6 noro 4548: pb[ZTOS((Q)ARG0(ti))] = db[ZTOS((Q)ARG1(ti))];
1.1 noro 4549: }
4550: for ( t = trace; t; t = NEXT(t) ) {
4551: ti = BDY((LIST)BDY(t));
1.6 noro 4552: pb[ZTOS((Q)ARG0(ti))] = recompute_trace(BDY((LIST)ARG1(ti)),pb,m);
4553: if ( !pb[ZTOS((Q)ARG0(ti))] ) { *rp = 0; return; }
1.1 noro 4554: if ( DP_Print ) {
4555: fprintf(asir_out,"."); fflush(asir_out);
4556: }
4557: }
4558: for ( t = intred; t; t = NEXT(t) ) {
4559: ti = BDY((LIST)BDY(t));
1.6 noro 4560: pb[ZTOS((Q)ARG0(ti))] = recompute_trace(BDY((LIST)ARG1(ti)),pb,m);
4561: if ( !pb[ZTOS((Q)ARG0(ti))] ) { *rp = 0; return; }
1.1 noro 4562: if ( DP_Print ) {
4563: fprintf(asir_out,"*"); fflush(asir_out);
4564: }
4565: }
4566: for ( r0 = 0, t = ind; t; t = NEXT(t) ) {
4567: NEXTNODE(r0,r);
1.6 noro 4568: b = pb[ZTOS((Q)BDY(t))];
1.1 noro 4569: ndv_mul_c(m,b,invm(HCM(b),m));
4570: #if 0
1.6 noro 4571: BDY(r) = ndvtop(m,CO,vv,pb[ZTOS((Q)BDY(t))]);
1.1 noro 4572: #else
1.6 noro 4573: BDY(r) = ndvtodp(m,pb[ZTOS((Q)BDY(t))]);
1.1 noro 4574: #endif
4575: }
4576: if ( r0 ) NEXT(r) = 0;
4577: MKLIST(*rp,r0);
4578: if ( DP_Print ) fprintf(asir_out,"\n");
4579: }
4580:
1.16 noro 4581: 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 4582: {
4583: VL tv,fv,vv,vc,av;
4584: NODE fd,fd0,in0,in,r,r0,t,s,cand,alist;
4585: int m,nocheck,nvar,mindex,e,max;
4586: NDV c;
4587: NMV a;
4588: P p,zp;
4589: Q dmy;
4590: EPOS oepos;
4591: int obpe,oadv,wmax,i,len,cbpe,ishomo,nalg,mrank,trank,ompos;
4592: Alg alpha,dp;
4593: P poly;
4594: LIST f1,f2,zpl;
4595: Obj obj;
4596: NumberField nf;
4597: struct order_spec *ord1;
4598: struct oEGT eg_check,eg0,eg1;
4599: NODE tr,tl1,tl2,tl3,tl4;
4600: LIST l1,l2,l3,l4,l5;
4601: int *perm;
4602: int j,ret;
4603: Z jq,bpe;
1.15 noro 4604: VECT hvect;
1.1 noro 4605:
4606: nd_module = 0;
4607: nd_lf = 0;
4608: parse_nd_option(current_option);
4609: if ( nd_lf ) {
4610: if ( f4 )
4611: nd_f4_lf_trace(f,v,trace,homo,ord,rp);
4612: else
4613: error("nd_gr_trace is not implemented yet over a large finite field");
4614: return;
4615: }
4616: if ( DP_Multiple )
4617: nd_scale = ((double)DP_Multiple)/(double)(Denominator?Denominator:1);
4618:
4619: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
4620: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
4621: switch ( ord->id ) {
4622: case 1:
4623: if ( ord->nv != nvar )
4624: error("nd_gr_trace : invalid order specification");
4625: break;
4626: default:
4627: break;
4628: }
4629:
4630: get_algtree((Obj)f,&av);
4631: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++ );
4632: nd_ntrans = nvar;
4633: nd_nalg = nalg;
4634: /* #i -> t#i */
4635: if ( nalg ) {
4636: preprocess_algcoef(vv,av,ord,f,&ord1,&f1,&alist);
4637: ord = ord1;
4638: f = f1;
4639: }
4640: nvar += nalg;
4641:
4642: nocheck = 0;
4643: mindex = 0;
4644:
4645: if ( Demand ) nd_demand = 1;
4646: else nd_demand = 0;
4647:
4648: /* setup modulus */
4649: if ( trace < 0 ) {
4650: trace = -trace;
4651: nocheck = 1;
4652: }
4653: m = trace > 1 ? trace : get_lprime(mindex);
4654: nd_init_ord(ord);
4655: mrank = 0;
4656: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
4657: for ( tv = vv; tv; tv = NEXT(tv) ) {
4658: if ( nd_module ) {
1.16 noro 4659: if ( OID(BDY(t)) == O_DPM ) {
4660: e = dpm_getdeg((DPM)BDY(t),&trank);
4661: max = MAX(e,max);
4662: mrank = MAX(mrank,trank);
4663: } else {
1.1 noro 4664: s = BDY((LIST)BDY(t));
4665: trank = length(s);
4666: mrank = MAX(mrank,trank);
4667: for ( ; s; s = NEXT(s) ) {
4668: e = getdeg(tv->v,(P)BDY(s));
4669: max = MAX(e,max);
4670: }
1.16 noro 4671: }
1.1 noro 4672: } else {
4673: e = getdeg(tv->v,(P)BDY(t));
4674: max = MAX(e,max);
4675: }
4676: }
4677: nd_setup_parameters(nvar,max);
4678: obpe = nd_bpe; oadv = nmv_adv; oepos = nd_epos; ompos = nd_mpos;
4679: ishomo = 1;
4680: for ( in0 = 0, fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
4681: if ( nd_module ) {
1.16 noro 4682: if ( OID(BDY(t)) == O_DPM ) {
4683: Z cont;
4684: DPM zdpm;
4685:
1.17 noro 4686: if ( !nd_gentrace ) dpm_ptozp((DPM)BDY(t),&cont,&zdpm);
1.16 noro 4687: else zdpm = (DPM)BDY(t);
4688: c = (pointer)dpmtondv(m,zdpm);
4689: } else {
4690: if ( !nd_gentrace ) pltozpl((LIST)BDY(t),&dmy,&zpl);
4691: else zpl = (LIST)BDY(t);
1.1 noro 4692: c = (pointer)pltondv(CO,vv,zpl);
1.16 noro 4693: }
1.1 noro 4694: } else {
1.16 noro 4695: if ( !nd_gentrace ) ptozp((P)BDY(t),1,&dmy,&zp);
4696: else zp = (P)BDY(t);
4697: c = (pointer)ptondv(CO,vv,zp);
1.1 noro 4698: }
4699: if ( ishomo )
4700: ishomo = ishomo && ndv_ishomo(c);
4701: if ( c ) {
4702: NEXTNODE(in0,in); BDY(in) = (pointer)c;
4703: NEXTNODE(fd0,fd); BDY(fd) = (pointer)ndv_dup(0,c);
4704: }
4705: }
4706: if ( in0 ) NEXT(in) = 0;
4707: if ( fd0 ) NEXT(fd) = 0;
4708: if ( !ishomo && homo ) {
4709: for ( t = in0, wmax = max; t; t = NEXT(t) ) {
4710: c = (NDV)BDY(t); len = LEN(c);
4711: for ( a = BDY(c), i = 0; i < len; i++, NMV_ADV(a) )
4712: wmax = MAX(TD(DL(a)),wmax);
4713: }
4714: homogenize_order(ord,nvar,&ord1);
4715: nd_init_ord(ord1);
4716: nd_setup_parameters(nvar+1,wmax);
4717: for ( t = fd0; t; t = NEXT(t) )
4718: ndv_homogenize((NDV)BDY(t),obpe,oadv,oepos,ompos);
4719: }
4720: if ( MaxDeg > 0 ) nocheck = 1;
4721: while ( 1 ) {
4722: tl1 = tl2 = tl3 = tl4 = 0;
4723: if ( Demand )
4724: nd_demand = 1;
1.24 noro 4725: ret = ndv_setup(m,1,fd0,nd_gbblock?1:0,0,0);
1.1 noro 4726: if ( nd_gentrace ) {
4727: MKLIST(l1,nd_tracelist); MKNODE(nd_alltracelist,l1,0);
4728: }
4729: if ( ret )
4730: cand = f4?nd_f4_trace(m,&perm):nd_gb_trace(m,ishomo || homo,&perm);
4731: if ( !ret || !cand ) {
4732: /* failure */
4733: if ( trace > 1 ) { *rp = 0; return; }
4734: else m = get_lprime(++mindex);
4735: continue;
4736: }
1.15 noro 4737: if ( nd_gentrace ) {
4738: MKVECT(hvect,nd_psn);
4739: for ( i = 0; i < nd_psn; i++ )
4740: ndltodp(nd_psh[i]->dl,(DP *)&BDY(hvect)[i]);
4741: }
1.1 noro 4742: if ( !ishomo && homo ) {
4743: /* dehomogenization */
4744: for ( t = cand; t; t = NEXT(t) ) ndv_dehomogenize((NDV)BDY(t),ord);
4745: nd_init_ord(ord);
4746: nd_setup_parameters(nvar,0);
4747: }
4748: nd_demand = 0;
4749: cand = ndv_reducebase(cand,perm);
4750: if ( nd_gentrace ) { tl1 = nd_alltracelist; nd_alltracelist = 0; }
4751: cand = ndv_reduceall(0,cand);
4752: cbpe = nd_bpe;
4753: if ( nd_gentrace ) { tl2 = nd_alltracelist; nd_alltracelist = 0; }
4754: get_eg(&eg0);
4755: if ( nocheck )
4756: break;
4757: if ( (ret = ndv_check_membership(0,in0,obpe,oadv,oepos,cand)) != 0 ) {
4758: if ( nd_gentrace ) {
4759: tl3 = nd_alltracelist; nd_alltracelist = 0;
4760: } else tl3 = 0;
4761: /* gbcheck : cand is a GB of Id(cand) ? */
4762: if ( nd_vc || nd_gentrace || nd_gensyz )
4763: ret = nd_gb(0,0,1,nd_gensyz?1:0,0)!=0;
4764: else
4765: ret = nd_f4(0,1,0)!=0;
4766: if ( nd_gentrace && nd_gensyz ) {
4767: tl4 = nd_alltracelist; nd_alltracelist = 0;
4768: } else tl4 = 0;
4769: }
4770: if ( ret ) break;
4771: else if ( trace > 1 ) {
4772: /* failure */
4773: *rp = 0; return;
4774: } else {
4775: /* try the next modulus */
4776: m = get_lprime(++mindex);
4777: /* reset the parameters */
4778: if ( !ishomo && homo ) {
4779: nd_init_ord(ord1);
4780: nd_setup_parameters(nvar+1,wmax);
4781: } else {
4782: nd_init_ord(ord);
4783: nd_setup_parameters(nvar,max);
4784: }
4785: }
4786: }
4787: get_eg(&eg1); init_eg(&eg_check); add_eg(&eg_check,&eg0,&eg1);
4788: if ( DP_Print )
1.6 noro 4789: fprintf(asir_out,"check=%.3fsec\n",eg_check.exectime);
1.1 noro 4790: /* dp->p */
4791: nd_bpe = cbpe;
4792: nd_setup_parameters(nd_nvar,0);
4793: for ( r = cand; r; r = NEXT(r) ) {
1.16 noro 4794: if ( nd_module ) {
1.17 noro 4795: if ( retdp ) BDY(r) = ndvtodpm(0,BDY(r));
1.16 noro 4796: else BDY(r) = ndvtopl(0,CO,vv,BDY(r),mrank);
1.17 noro 4797: } else if ( retdp ) BDY(r) = ndvtodp(0,BDY(r));
4798: else BDY(r) = (pointer)ndvtop(0,CO,vv,BDY(r));
1.1 noro 4799: }
4800: if ( nd_nalg )
4801: cand = postprocess_algcoef(av,alist,cand);
4802: MKLIST(*rp,cand);
4803: if ( nd_gentrace ) {
4804: tl1 = reverse_node(tl1); tl2 = reverse_node(tl2);
4805: tl3 = reverse_node(tl3);
4806: /* tl2 = [[i,[[*,j,*,*],...]],...] */
4807: for ( t = tl2; t; t = NEXT(t) ) {
4808: /* s = [i,[*,j,*,*],...] */
4809: s = BDY((LIST)BDY(t));
1.6 noro 4810: j = perm[ZTOS((Q)ARG0(s))]; STOZ(j,jq); ARG0(s) = (pointer)jq;
1.1 noro 4811: for ( s = BDY((LIST)ARG1(s)); s; s = NEXT(s) ) {
1.6 noro 4812: j = perm[ZTOS((Q)ARG1(BDY((LIST)BDY(s))))]; STOZ(j,jq);
1.1 noro 4813: ARG1(BDY((LIST)BDY(s))) = (pointer)jq;
4814: }
4815: }
4816: for ( j = length(cand)-1, t = 0; j >= 0; j-- ) {
1.6 noro 4817: STOZ(perm[j],jq); MKNODE(s,jq,t); t = s;
1.1 noro 4818: }
4819: MKLIST(l1,tl1); MKLIST(l2,tl2); MKLIST(l3,t); MKLIST(l4,tl3);
4820: MKLIST(l5,tl4);
1.6 noro 4821: STOZ(nd_bpe,bpe);
1.15 noro 4822: tr = mknode(9,*rp,(!ishomo&&homo)?ONE:0,l1,l2,l3,l4,l5,bpe,hvect); MKLIST(*rp,tr);
1.1 noro 4823: }
4824: }
4825:
4826: /* XXX : module element is not considered */
4827:
4828: void dltondl(int n,DL dl,UINT *r)
4829: {
4830: UINT *d;
4831: int i,j,l,s,ord_l;
4832: struct order_pair *op;
4833:
4834: d = (unsigned int *)dl->d;
4835: for ( i = 0; i < nd_wpd; i++ ) r[i] = 0;
4836: if ( nd_blockmask ) {
4837: l = nd_blockmask->n;
4838: op = nd_blockmask->order_pair;
4839: for ( j = 0, s = 0; j < l; j++ ) {
4840: ord_l = op[j].length;
4841: for ( i = 0; i < ord_l; i++, s++ ) PUT_EXP(r,s,d[s]);
4842: }
4843: TD(r) = ndl_weight(r);
4844: ndl_weight_mask(r);
4845: } else {
4846: for ( i = 0; i < n; i++ ) PUT_EXP(r,i,d[i]);
4847: TD(r) = ndl_weight(r);
4848: }
4849: }
4850:
4851: DL ndltodl(int n,UINT *ndl)
4852: {
4853: DL dl;
4854: int *d;
4855: int i,j,l,s,ord_l;
4856: struct order_pair *op;
4857:
4858: NEWDL(dl,n);
4859: dl->td = TD(ndl);
4860: d = dl->d;
4861: if ( nd_blockmask ) {
4862: l = nd_blockmask->n;
4863: op = nd_blockmask->order_pair;
4864: for ( j = 0, s = 0; j < l; j++ ) {
4865: ord_l = op[j].length;
4866: for ( i = 0; i < ord_l; i++, s++ ) d[s] = GET_EXP(ndl,s);
4867: }
4868: } else {
4869: for ( i = 0; i < n; i++ ) d[i] = GET_EXP(ndl,i);
4870: }
4871: return dl;
4872: }
4873:
1.24 noro 4874: void _ndltodl(UINT *ndl,DL dl)
4875: {
4876: int *d;
4877: int i,j,l,s,ord_l,n;
4878: struct order_pair *op;
4879:
4880: n = nd_nvar;
4881: dl->td = TD(ndl);
4882: d = dl->d;
4883: if ( nd_blockmask ) {
4884: l = nd_blockmask->n;
4885: op = nd_blockmask->order_pair;
4886: for ( j = 0, s = 0; j < l; j++ ) {
4887: ord_l = op[j].length;
4888: for ( i = 0; i < ord_l; i++, s++ ) d[s] = GET_EXP(ndl,s);
4889: }
4890: } else {
4891: for ( i = 0; i < n; i++ ) d[i] = GET_EXP(ndl,i);
4892: }
4893: }
4894:
1.1 noro 4895: void nmtodp(int mod,NM m,DP *r)
4896: {
4897: DP dp;
4898: MP mr;
4899:
4900: NEWMP(mr);
4901: mr->dl = ndltodl(nd_nvar,DL(m));
4902: mr->c = (Obj)ndctop(mod,m->c);
4903: NEXT(mr) = 0; MKDP(nd_nvar,mr,dp); dp->sugar = mr->dl->td;
4904: *r = dp;
4905: }
4906:
1.15 noro 4907: void ndltodp(UINT *d,DP *r)
4908: {
4909: DP dp;
4910: MP mr;
4911:
4912: NEWMP(mr);
4913: mr->dl = ndltodl(nd_nvar,d);
4914: mr->c = (Obj)ONE;
4915: NEXT(mr) = 0; MKDP(nd_nvar,mr,dp); dp->sugar = mr->dl->td;
4916: *r = dp;
4917: }
4918:
1.1 noro 4919: void ndl_print(UINT *dl)
4920: {
4921: int n;
4922: int i,j,l,ord_l,s,s0;
4923: struct order_pair *op;
4924:
4925: n = nd_nvar;
4926: printf("<<");
4927: if ( nd_blockmask ) {
4928: l = nd_blockmask->n;
4929: op = nd_blockmask->order_pair;
4930: for ( j = 0, s = s0 = 0; j < l; j++ ) {
4931: ord_l = op[j].length;
4932: for ( i = 0; i < ord_l; i++, s++ )
4933: printf(s==n-1?"%d":"%d,",GET_EXP(dl,s));
4934: }
4935: } else {
4936: for ( i = 0; i < n; i++ ) printf(i==n-1?"%d":"%d,",GET_EXP(dl,i));
4937: }
4938: printf(">>");
4939: if ( nd_module && MPOS(dl) )
4940: printf("*e%d",MPOS(dl));
4941: }
4942:
4943: void nd_print(ND p)
4944: {
4945: NM m;
4946:
4947: if ( !p )
4948: printf("0\n");
4949: else {
4950: for ( m = BDY(p); m; m = NEXT(m) ) {
4951: if ( CM(m) & 0x80000000 ) printf("+@_%d*",IFTOF(CM(m)));
1.28 noro 4952: else printf("+%ld*",CM(m));
1.1 noro 4953: ndl_print(DL(m));
4954: }
4955: printf("\n");
4956: }
4957: }
4958:
4959: void nd_print_q(ND p)
4960: {
4961: NM m;
4962:
4963: if ( !p )
4964: printf("0\n");
4965: else {
4966: for ( m = BDY(p); m; m = NEXT(m) ) {
4967: printf("+");
1.6 noro 4968: printexpr(CO,(Obj)CZ(m));
1.1 noro 4969: printf("*");
4970: ndl_print(DL(m));
4971: }
4972: printf("\n");
4973: }
4974: }
4975:
4976: void ndp_print(ND_pairs d)
4977: {
4978: ND_pairs t;
4979:
4980: for ( t = d; t; t = NEXT(t) ) printf("%d,%d ",t->i1,t->i2);
4981: printf("\n");
4982: }
4983:
4984: void nd_removecont(int mod,ND p)
4985: {
4986: int i,n;
4987: Z *w;
4988: NM m;
4989: struct oVECT v;
4990:
4991: if ( mod == -1 ) nd_mul_c(mod,p,_invsf(HCM(p)));
4992: else if ( mod == -2 ) {
4993: Z inv;
4994: divlf(ONE,HCZ(p),&inv);
4995: nd_mul_c_lf(p,inv);
4996: } else if ( mod ) nd_mul_c(mod,p,invm(HCM(p),mod));
4997: else {
4998: for ( m = BDY(p), n = 0; m; m = NEXT(m), n++ );
4999: w = (Z *)MALLOC(n*sizeof(Q));
5000: v.len = n;
5001: v.body = (pointer *)w;
1.6 noro 5002: for ( m = BDY(p), i = 0; i < n; m = NEXT(m), i++ ) w[i] = CZ(m);
1.1 noro 5003: removecont_array((P *)w,n,1);
1.6 noro 5004: for ( m = BDY(p), i = 0; i < n; m = NEXT(m), i++ ) CZ(m) = w[i];
1.1 noro 5005: }
5006: }
5007:
5008: void nd_removecont2(ND p1,ND p2)
5009: {
5010: int i,n1,n2,n;
5011: Z *w;
5012: NM m;
5013: struct oVECT v;
5014:
5015: n1 = nd_length(p1);
5016: n2 = nd_length(p2);
5017: n = n1+n2;
5018: w = (Z *)MALLOC(n*sizeof(Q));
5019: v.len = n;
5020: v.body = (pointer *)w;
5021: i = 0;
5022: if ( p1 )
1.6 noro 5023: for ( m = BDY(p1); i < n1; m = NEXT(m), i++ ) w[i] = CZ(m);
1.1 noro 5024: if ( p2 )
1.6 noro 5025: for ( m = BDY(p2); i < n; m = NEXT(m), i++ ) w[i] = CZ(m);
1.1 noro 5026: removecont_array((P *)w,n,1);
5027: i = 0;
5028: if ( p1 )
1.6 noro 5029: for ( m = BDY(p1); i < n1; m = NEXT(m), i++ ) CZ(m) = w[i];
1.1 noro 5030: if ( p2 )
1.6 noro 5031: for ( m = BDY(p2); i < n; m = NEXT(m), i++ ) CZ(m) = w[i];
1.1 noro 5032: }
5033:
5034: void ndv_removecont(int mod,NDV p)
5035: {
5036: int i,len,all_p;
5037: Z *c;
5038: P *w;
5039: Z dvr,t;
5040: P g,cont,tp;
5041: NMV m;
5042:
5043: if ( mod == -1 )
5044: ndv_mul_c(mod,p,_invsf(HCM(p)));
5045: else if ( mod == -2 ) {
5046: Z inv;
5047: divlf(ONE,HCZ(p),&inv);
5048: ndv_mul_c_lf(p,inv);
5049: } else if ( mod )
5050: ndv_mul_c(mod,p,invm(HCM(p),mod));
5051: else {
5052: len = p->len;
5053: w = (P *)MALLOC(len*sizeof(P));
5054: c = (Z *)MALLOC(len*sizeof(Q));
5055: for ( m = BDY(p), all_p = 1, i = 0; i < len; NMV_ADV(m), i++ ) {
5056: ptozp(CP(m),1,(Q *)&c[i],&w[i]);
5057: all_p = all_p && !NUM(w[i]);
5058: }
5059: if ( all_p ) {
5060: qltozl((Q *)c,len,&dvr); nd_heu_nezgcdnpz(nd_vc,w,len,1,&g);
5061: mulp(nd_vc,(P)dvr,g,&cont);
5062: for ( m = BDY(p), i = 0; i < len; NMV_ADV(m), i++ ) {
5063: divsp(nd_vc,CP(m),cont,&tp); CP(m) = tp;
5064: }
5065: } else {
5066: sortbynm((Q *)c,len);
5067: qltozl((Q *)c,len,&dvr);
5068: for ( m = BDY(p), i = 0; i < len; NMV_ADV(m), i++ ) {
5069: divsp(nd_vc,CP(m),(P)dvr,&tp); CP(m) = tp;
5070: }
5071: }
5072: }
5073: }
5074:
5075: /* koko */
5076:
5077: void ndv_homogenize(NDV p,int obpe,int oadv,EPOS oepos,int ompos)
5078: {
5079: int len,i,max;
5080: NMV m,mr0,mr,t;
5081:
5082: len = p->len;
1.14 noro 5083: for ( m = BDY(p), i = 0, max = 0; i < len; NMV_OADV(m), i++ )
1.1 noro 5084: max = MAX(max,TD(DL(m)));
5085: mr0 = nmv_adv>oadv?(NMV)REALLOC(BDY(p),len*nmv_adv):BDY(p);
5086: m = (NMV)((char *)mr0+(len-1)*oadv);
5087: mr = (NMV)((char *)mr0+(len-1)*nmv_adv);
5088: t = (NMV)MALLOC(nmv_adv);
5089: for ( i = 0; i < len; i++, NMV_OPREV(m), NMV_PREV(mr) ) {
5090: ndl_homogenize(DL(m),DL(t),obpe,oepos,ompos,max);
1.6 noro 5091: CZ(mr) = CZ(m);
1.1 noro 5092: ndl_copy(DL(t),DL(mr));
5093: }
5094: NV(p)++;
5095: BDY(p) = mr0;
5096: }
5097:
5098: void ndv_dehomogenize(NDV p,struct order_spec *ord)
5099: {
5100: int i,j,adj,len,newnvar,newwpd,newadv,newexporigin,newmpos;
5101: int pos;
5102: Q *w;
5103: Q dvr,t;
5104: NMV m,r;
5105:
5106: len = p->len;
5107: newnvar = nd_nvar-1;
5108: newexporigin = nd_get_exporigin(ord);
5109: if ( nd_module ) newmpos = newexporigin-1;
5110: newwpd = newnvar/nd_epw+(newnvar%nd_epw?1:0)+newexporigin;
5111: for ( m = BDY(p), i = 0; i < len; NMV_ADV(m), i++ )
5112: ndl_dehomogenize(DL(m));
5113: if ( newwpd != nd_wpd ) {
5114: newadv = ROUND_FOR_ALIGN(sizeof(struct oNMV)+(newwpd-1)*sizeof(UINT));
5115: for ( m = r = BDY(p), i = 0; i < len; NMV_ADV(m), NDV_NADV(r), i++ ) {
1.6 noro 5116: CZ(r) = CZ(m);
1.1 noro 5117: if ( nd_module ) pos = MPOS(DL(m));
5118: for ( j = 0; j < newexporigin; j++ ) DL(r)[j] = DL(m)[j];
5119: adj = nd_exporigin-newexporigin;
5120: for ( ; j < newwpd; j++ ) DL(r)[j] = DL(m)[j+adj];
5121: if ( nd_module ) {
5122: DL(r)[newmpos] = pos;
5123: }
5124: }
5125: }
5126: NV(p)--;
5127: }
5128:
5129: void nd_heu_nezgcdnpz(VL vl,P *pl,int m,int full,P *pr)
5130: {
5131: int i;
5132: P *tpl,*tpl1;
5133: NODE l;
5134: P h,gcd,t;
5135:
5136: tpl = (P *)MALLOC(m*sizeof(P));
5137: tpl1 = (P *)MALLOC(m*sizeof(P));
5138: bcopy(pl,tpl,m*sizeof(P));
5139: gcd = (P)ONE;
5140: for ( l = nd_hcf; l; l = NEXT(l) ) {
5141: h = (P)BDY(l);
5142: while ( 1 ) {
5143: for ( i = 0; i < m; i++ )
5144: if ( !divtpz(vl,tpl[i],h,&tpl1[i]) )
5145: break;
5146: if ( i == m ) {
5147: bcopy(tpl1,tpl,m*sizeof(P));
5148: mulp(vl,gcd,h,&t); gcd = t;
5149: } else
5150: break;
5151: }
5152: }
5153: if ( DP_Print > 2 ){fprintf(asir_out,"[%d]",nmonop(gcd)); fflush(asir_out);}
5154: if ( full ) {
5155: heu_nezgcdnpz(vl,tpl,m,&t);
5156: mulp(vl,gcd,t,pr);
5157: } else
5158: *pr = gcd;
5159: }
5160:
5161: void removecont_array(P *p,int n,int full)
5162: {
5163: int all_p,all_q,i;
5164: Z *c;
5165: P *w;
5166: P t,s;
5167:
5168: for ( all_q = 1, i = 0; i < n; i++ )
5169: all_q = all_q && NUM(p[i]);
5170: if ( all_q ) {
5171: removecont_array_q((Z *)p,n);
5172: } else {
5173: c = (Z *)MALLOC(n*sizeof(Z));
5174: w = (P *)MALLOC(n*sizeof(P));
5175: for ( i = 0; i < n; i++ ) {
5176: ptozp(p[i],1,(Q *)&c[i],&w[i]);
5177: }
5178: removecont_array_q(c,n);
5179: nd_heu_nezgcdnpz(nd_vc,w,n,full,&t);
5180: for ( i = 0; i < n; i++ ) {
5181: divsp(nd_vc,w[i],t,&s); mulp(nd_vc,s,(P)c[i],&p[i]);
5182: }
5183: }
5184: }
5185:
5186: /* c is an int array */
5187:
5188: void removecont_array_q(Z *c,int n)
5189: {
5190: struct oVECT v;
5191: Z d0,d1,a,u,u1,gcd;
5192: int i,j;
5193: Z *q,*r;
5194:
5195: q = (Z *)MALLOC(n*sizeof(Z));
5196: r = (Z *)MALLOC(n*sizeof(Z));
5197: v.id = O_VECT; v.len = n; v.body = (pointer *)c;
5198: gcdvz_estimate(&v,&d0);
5199: for ( i = 0; i < n; i++ ) {
5200: divqrz(c[i],d0,&q[i],&r[i]);
5201: }
5202: for ( i = 0; i < n; i++ ) if ( r[i] ) break;
5203: if ( i < n ) {
5204: v.id = O_VECT; v.len = n; v.body = (pointer *)r;
5205: gcdvz(&v,&d1);
5206: gcdz(d0,d1,&gcd);
1.6 noro 5207: /* exact division */
5208: divsz(d0,gcd,&a);
1.1 noro 5209: for ( i = 0; i < n; i++ ) {
5210: mulz(a,q[i],&u);
5211: if ( r[i] ) {
1.6 noro 5212: /* exact division */
5213: divsz(r[i],gcd,&u1);
1.1 noro 5214: addz(u,u1,&q[i]);
5215: } else
5216: q[i] = u;
5217: }
5218: }
5219: for ( i = 0; i < n; i++ ) c[i] = q[i];
5220: }
5221:
1.4 noro 5222: void gcdv_mpz_estimate(mpz_t d0,mpz_t *c,int n);
5223:
5224: void mpz_removecont_array(mpz_t *c,int n)
5225: {
5226: mpz_t d0,a,u,u1,gcd;
5227: int i,j;
1.13 noro 5228: static mpz_t *q,*r;
5229: static int c_len = 0;
1.4 noro 5230:
5231: for ( i = 0; i < n; i++ )
5232: if ( mpz_sgn(c[i]) ) break;
5233: if ( i == n ) return;
5234: gcdv_mpz_estimate(d0,c,n);
1.13 noro 5235: if ( n > c_len ) {
5236: q = (mpz_t *)MALLOC(n*sizeof(mpz_t));
5237: r = (mpz_t *)MALLOC(n*sizeof(mpz_t));
5238: c_len = n;
5239: }
1.4 noro 5240: for ( i = 0; i < n; i++ ) {
5241: mpz_init(q[i]); mpz_init(r[i]);
5242: mpz_fdiv_qr(q[i],r[i],c[i],d0);
5243: }
5244: for ( i = 0; i < n; i++ )
5245: if ( mpz_sgn(r[i]) ) break;
5246: mpz_init(gcd); mpz_init(a); mpz_init(u); mpz_init(u1);
5247: if ( i < n ) {
5248: mpz_gcd(gcd,d0,r[i]);
5249: for ( j = i+1; j < n; j++ ) mpz_gcd(gcd,gcd,r[j]);
5250: mpz_div(a,d0,gcd);
5251: for ( i = 0; i < n; i++ ) {
5252: mpz_mul(u,a,q[i]);
5253: if ( mpz_sgn(r[i]) ) {
5254: mpz_div(u1,r[i],gcd);
5255: mpz_add(q[i],u,u1);
5256: } else
5257: mpz_set(q[i],u);
5258: }
5259: }
5260: for ( i = 0; i < n; i++ )
5261: mpz_set(c[i],q[i]);
5262: }
5263:
1.1 noro 5264: void nd_mul_c(int mod,ND p,int mul)
5265: {
5266: NM m;
5267: int c,c1;
5268:
5269: if ( !p ) return;
5270: if ( mul == 1 ) return;
5271: if ( mod == -1 )
5272: for ( m = BDY(p); m; m = NEXT(m) )
5273: CM(m) = _mulsf(CM(m),mul);
5274: else
5275: for ( m = BDY(p); m; m = NEXT(m) ) {
5276: c1 = CM(m); DMAR(c1,mul,0,mod,c); CM(m) = c;
5277: }
5278: }
5279:
5280: void nd_mul_c_lf(ND p,Z mul)
5281: {
5282: NM m;
5283: Z c;
5284:
5285: if ( !p ) return;
5286: if ( UNIZ(mul) ) return;
5287: for ( m = BDY(p); m; m = NEXT(m) ) {
5288: mullf(CZ(m),mul,&c); CZ(m) = c;
5289: }
5290: }
5291:
5292: void nd_mul_c_q(ND p,P mul)
5293: {
5294: NM m;
5295: P c;
5296:
5297: if ( !p ) return;
5298: if ( UNIQ(mul) ) return;
5299: for ( m = BDY(p); m; m = NEXT(m) ) {
5300: mulp(nd_vc,CP(m),mul,&c); CP(m) = c;
5301: }
5302: }
5303:
5304: void nd_mul_c_p(VL vl,ND p,P mul)
5305: {
5306: NM m;
5307: P c;
5308:
5309: if ( !p ) return;
5310: for ( m = BDY(p); m; m = NEXT(m) ) {
5311: mulp(vl,CP(m),mul,&c); CP(m) = c;
5312: }
5313: }
5314:
5315: void nd_free(ND p)
5316: {
5317: NM t,s;
5318:
5319: if ( !p ) return;
5320: t = BDY(p);
5321: while ( t ) {
5322: s = NEXT(t);
5323: FREENM(t);
5324: t = s;
5325: }
5326: FREEND(p);
5327: }
5328:
5329: void ndv_free(NDV p)
5330: {
5331: GCFREE(BDY(p));
5332: }
5333:
5334: void nd_append_red(UINT *d,int i)
5335: {
5336: RHist m,m0;
5337: int h;
5338:
5339: NEWRHist(m);
5340: h = ndl_hash_value(d);
5341: m->index = i;
5342: ndl_copy(d,DL(m));
5343: NEXT(m) = nd_red[h];
5344: nd_red[h] = m;
5345: }
5346:
5347: UINT *ndv_compute_bound(NDV p)
5348: {
5349: UINT *d1,*d2,*t;
5350: UINT u;
5351: int i,j,k,l,len,ind;
5352: NMV m;
5353:
5354: if ( !p )
5355: return 0;
5356: d1 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
5357: d2 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
5358: len = LEN(p);
5359: m = BDY(p); ndl_copy(DL(m),d1); NMV_ADV(m);
5360: for ( i = 1; i < len; i++, NMV_ADV(m) ) {
5361: ndl_max(DL(m),d1,d2);
5362: t = d1; d1 = d2; d2 = t;
5363: }
5364: l = nd_nvar+31;
5365: t = (UINT *)MALLOC_ATOMIC(l*sizeof(UINT));
5366: for ( i = nd_exporigin, ind = 0; i < nd_wpd; i++ ) {
5367: u = d1[i];
5368: k = (nd_epw-1)*nd_bpe;
5369: for ( j = 0; j < nd_epw; j++, k -= nd_bpe, ind++ )
5370: t[ind] = (u>>k)&nd_mask0;
5371: }
5372: for ( ; ind < l; ind++ ) t[ind] = 0;
5373: return t;
5374: }
5375:
5376: UINT *nd_compute_bound(ND p)
5377: {
5378: UINT *d1,*d2,*t;
5379: UINT u;
5380: int i,j,k,l,len,ind;
5381: NM m;
5382:
5383: if ( !p )
5384: return 0;
5385: d1 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
5386: d2 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
5387: len = LEN(p);
5388: m = BDY(p); ndl_copy(DL(m),d1); m = NEXT(m);
5389: for ( m = NEXT(m); m; m = NEXT(m) ) {
5390: ndl_lcm(DL(m),d1,d2);
5391: t = d1; d1 = d2; d2 = t;
5392: }
5393: l = nd_nvar+31;
5394: t = (UINT *)MALLOC_ATOMIC(l*sizeof(UINT));
5395: for ( i = nd_exporigin, ind = 0; i < nd_wpd; i++ ) {
5396: u = d1[i];
5397: k = (nd_epw-1)*nd_bpe;
5398: for ( j = 0; j < nd_epw; j++, k -= nd_bpe, ind++ )
5399: t[ind] = (u>>k)&nd_mask0;
5400: }
5401: for ( ; ind < l; ind++ ) t[ind] = 0;
5402: return t;
5403: }
5404:
5405: /* if nd_module == 1 then d[nd_exporigin-1] indicates the position */
5406: /* of a term. In this case we need additional 1 word. */
5407:
5408: int nd_get_exporigin(struct order_spec *ord)
5409: {
5410: switch ( ord->id ) {
1.21 noro 5411: case 0: case 2: case 256: case 258: case 300:
1.1 noro 5412: return 1+nd_module;
5413: case 1: case 257:
5414: /* block order */
5415: /* poly ring d[0]:weight d[1]:w0,...,d[nd_exporigin-1]:w(n-1) */
5416: /* module d[0]:weight d[1]:w0,...,d[nd_exporigin-2]:w(n-1) */
5417: return ord->ord.block.length+1+nd_module;
5418: case 3: case 259:
5419: #if 0
5420: error("nd_get_exporigin : composite order is not supported yet.");
5421: #else
5422: return 1+nd_module;
5423: #endif
5424: default:
5425: error("nd_get_exporigin : ivalid argument.");
5426: return 0;
5427: }
5428: }
5429:
5430: void nd_setup_parameters(int nvar,int max) {
5431: int i,j,n,elen,ord_o,ord_l,l,s,wpd;
5432: struct order_pair *op;
5433:
5434: nd_nvar = nvar;
5435: if ( max ) {
5436: /* XXX */
5437: if ( do_weyl ) nd_bpe = 32;
5438: else if ( max < 2 ) nd_bpe = 1;
5439: else if ( max < 4 ) nd_bpe = 2;
5440: else if ( max < 8 ) nd_bpe = 3;
5441: else if ( max < 16 ) nd_bpe = 4;
5442: else if ( max < 32 ) nd_bpe = 5;
5443: else if ( max < 64 ) nd_bpe = 6;
5444: else if ( max < 256 ) nd_bpe = 8;
5445: else if ( max < 1024 ) nd_bpe = 10;
5446: else if ( max < 65536 ) nd_bpe = 16;
5447: else nd_bpe = 32;
5448: }
5449: if ( !do_weyl && weight_check && (current_dl_weight_vector || nd_matrix) ) {
5450: UINT t;
5451: int st;
5452: int *v;
5453: /* t = max(weights) */
5454: t = 0;
5455: if ( current_dl_weight_vector )
5456: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
5457: if ( (st=current_dl_weight_vector[i]) < 0 ) st = -st;
5458: if ( t < st ) t = st;
5459: }
5460: if ( nd_matrix )
5461: for ( i = 0; i < nd_matrix_len; i++ )
5462: for ( j = 0, v = nd_matrix[i]; j < nd_nvar; j++ ) {
5463: if ( (st=v[j]) < 0 ) st = -st;
5464: if ( t < st ) t = st;
5465: }
5466: /* i = bitsize of t */
5467: for ( i = 0; t; t >>=1, i++ );
5468: /* i += bitsize of nd_nvar */
5469: for ( t = nd_nvar; t; t >>=1, i++);
5470: /* nd_bpe+i = bitsize of max(weights)*max(exp)*nd_nvar */
5471: if ( (nd_bpe+i) >= 31 )
5472: error("nd_setup_parameters : too large weight");
5473: }
5474: nd_epw = (sizeof(UINT)*8)/nd_bpe;
5475: elen = nd_nvar/nd_epw+(nd_nvar%nd_epw?1:0);
5476: nd_exporigin = nd_get_exporigin(nd_ord);
5477: wpd = nd_exporigin+elen;
5478: if ( nd_module )
5479: nd_mpos = nd_exporigin-1;
5480: else
5481: nd_mpos = -1;
5482: if ( wpd != nd_wpd ) {
5483: nd_free_private_storage();
5484: nd_wpd = wpd;
5485: }
5486: if ( nd_bpe < 32 ) {
5487: nd_mask0 = (1<<nd_bpe)-1;
5488: } else {
5489: nd_mask0 = 0xffffffff;
5490: }
5491: bzero(nd_mask,sizeof(nd_mask));
5492: nd_mask1 = 0;
5493: for ( i = 0; i < nd_epw; i++ ) {
5494: nd_mask[nd_epw-i-1] = (nd_mask0<<(i*nd_bpe));
5495: nd_mask1 |= (1<<(nd_bpe-1))<<(i*nd_bpe);
5496: }
5497: nmv_adv = ROUND_FOR_ALIGN(sizeof(struct oNMV)+(nd_wpd-1)*sizeof(UINT));
5498: nd_epos = nd_create_epos(nd_ord);
5499: nd_blockmask = nd_create_blockmask(nd_ord);
5500: nd_work_vector = (int *)REALLOC(nd_work_vector,nd_nvar*sizeof(int));
5501: }
5502:
5503: ND_pairs nd_reconstruct(int trace,ND_pairs d)
5504: {
5505: int i,obpe,oadv,h;
5506: static NM prev_nm_free_list;
5507: static ND_pairs prev_ndp_free_list;
5508: RHist mr0,mr;
5509: RHist r;
5510: RHist *old_red;
5511: ND_pairs s0,s,t;
5512: EPOS oepos;
5513:
5514: obpe = nd_bpe;
5515: oadv = nmv_adv;
5516: oepos = nd_epos;
5517: if ( obpe < 2 ) nd_bpe = 2;
5518: else if ( obpe < 3 ) nd_bpe = 3;
5519: else if ( obpe < 4 ) nd_bpe = 4;
5520: else if ( obpe < 5 ) nd_bpe = 5;
5521: else if ( obpe < 6 ) nd_bpe = 6;
5522: else if ( obpe < 8 ) nd_bpe = 8;
5523: else if ( obpe < 10 ) nd_bpe = 10;
5524: else if ( obpe < 16 ) nd_bpe = 16;
5525: else if ( obpe < 32 ) nd_bpe = 32;
5526: else error("nd_reconstruct : exponent too large");
5527:
5528: nd_setup_parameters(nd_nvar,0);
5529: prev_nm_free_list = _nm_free_list;
5530: prev_ndp_free_list = _ndp_free_list;
5531: _nm_free_list = 0;
5532: _ndp_free_list = 0;
5533: for ( i = nd_psn-1; i >= 0; i-- ) {
5534: ndv_realloc(nd_ps[i],obpe,oadv,oepos);
5535: ndv_realloc(nd_ps_sym[i],obpe,oadv,oepos);
5536: }
5537: if ( trace )
5538: for ( i = nd_psn-1; i >= 0; i-- ) {
5539: ndv_realloc(nd_ps_trace[i],obpe,oadv,oepos);
5540: ndv_realloc(nd_ps_trace_sym[i],obpe,oadv,oepos);
5541: }
5542: s0 = 0;
5543: for ( t = d; t; t = NEXT(t) ) {
5544: NEXTND_pairs(s0,s);
5545: s->i1 = t->i1;
5546: s->i2 = t->i2;
1.24 noro 5547: s->sig = t->sig;
1.1 noro 5548: SG(s) = SG(t);
5549: ndl_reconstruct(LCM(t),LCM(s),obpe,oepos);
5550: }
5551:
5552: old_red = (RHist *)MALLOC(REDTAB_LEN*sizeof(RHist));
5553: for ( i = 0; i < REDTAB_LEN; i++ ) {
5554: old_red[i] = nd_red[i];
5555: nd_red[i] = 0;
5556: }
5557: for ( i = 0; i < REDTAB_LEN; i++ )
5558: for ( r = old_red[i]; r; r = NEXT(r) ) {
5559: NEWRHist(mr);
5560: mr->index = r->index;
5561: SG(mr) = SG(r);
5562: ndl_reconstruct(DL(r),DL(mr),obpe,oepos);
5563: h = ndl_hash_value(DL(mr));
5564: NEXT(mr) = nd_red[h];
5565: nd_red[h] = mr;
1.24 noro 5566: mr->sig = r->sig;
1.1 noro 5567: }
5568: for ( i = 0; i < REDTAB_LEN; i++ ) old_red[i] = 0;
5569: old_red = 0;
5570: for ( i = 0; i < nd_psn; i++ ) {
5571: NEWRHist(r); SG(r) = SG(nd_psh[i]);
5572: ndl_reconstruct(DL(nd_psh[i]),DL(r),obpe,oepos);
1.24 noro 5573: r->sig = nd_psh[i]->sig;
1.1 noro 5574: nd_psh[i] = r;
5575: }
5576: if ( s0 ) NEXT(s) = 0;
5577: prev_nm_free_list = 0;
5578: prev_ndp_free_list = 0;
5579: #if 0
5580: GC_gcollect();
5581: #endif
5582: return s0;
5583: }
5584:
5585: void ndl_reconstruct(UINT *d,UINT *r,int obpe,EPOS oepos)
5586: {
5587: int n,i,ei,oepw,omask0,j,s,ord_l,l;
5588: struct order_pair *op;
5589:
5590: n = nd_nvar;
5591: oepw = (sizeof(UINT)*8)/obpe;
5592: omask0 = (1<<obpe)-1;
5593: TD(r) = TD(d);
5594: for ( i = nd_exporigin; i < nd_wpd; i++ ) r[i] = 0;
5595: if ( nd_blockmask ) {
5596: l = nd_blockmask->n;
5597: op = nd_blockmask->order_pair;
5598: for ( i = 1; i < nd_exporigin; i++ )
5599: r[i] = d[i];
5600: for ( j = 0, s = 0; j < l; j++ ) {
5601: ord_l = op[j].length;
5602: for ( i = 0; i < ord_l; i++, s++ ) {
5603: ei = GET_EXP_OLD(d,s);
5604: PUT_EXP(r,s,ei);
5605: }
5606: }
5607: } else {
5608: for ( i = 0; i < n; i++ ) {
5609: ei = GET_EXP_OLD(d,i);
5610: PUT_EXP(r,i,ei);
5611: }
5612: }
5613: if ( nd_module ) MPOS(r) = MPOS(d);
5614: }
5615:
5616: ND nd_copy(ND p)
5617: {
5618: NM m,mr,mr0;
5619: int c,n;
5620: ND r;
5621:
5622: if ( !p )
5623: return 0;
5624: else {
5625: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
5626: NEXTNM(mr0,mr);
5627: CM(mr) = CM(m);
5628: ndl_copy(DL(m),DL(mr));
5629: }
5630: NEXT(mr) = 0;
5631: MKND(NV(p),mr0,LEN(p),r);
5632: SG(r) = SG(p);
5633: return r;
5634: }
5635: }
5636:
5637: int nd_sp(int mod,int trace,ND_pairs p,ND *rp)
5638: {
5639: NM m1,m2;
5640: NDV p1,p2;
5641: ND t1,t2;
5642: UINT *lcm;
5643: P gp,tp;
5644: Z g,t;
5645: Z iq;
5646: int td;
5647: LIST hist;
5648: NODE node;
5649: DP d;
5650:
5651: if ( !mod && nd_demand ) {
5652: p1 = ndv_load(p->i1); p2 = ndv_load(p->i2);
5653: } else {
5654: if ( trace ) {
5655: p1 = nd_ps_trace[p->i1]; p2 = nd_ps_trace[p->i2];
5656: } else {
5657: p1 = nd_ps[p->i1]; p2 = nd_ps[p->i2];
5658: }
5659: }
5660: lcm = LCM(p);
5661: NEWNM(m1); ndl_sub(lcm,HDL(p1),DL(m1));
5662: if ( ndl_check_bound2(p->i1,DL(m1)) ) {
5663: FREENM(m1); return 0;
5664: }
5665: NEWNM(m2); ndl_sub(lcm,HDL(p2),DL(m2));
5666: if ( ndl_check_bound2(p->i2,DL(m2)) ) {
5667: FREENM(m1); FREENM(m2); return 0;
5668: }
5669:
5670: if ( mod == -1 ) {
5671: CM(m1) = HCM(p2); CM(m2) = _chsgnsf(HCM(p1));
5672: } else if ( mod > 0 ) {
5673: CM(m1) = HCM(p2); CM(m2) = mod-HCM(p1);
5674: } else if ( mod == -2 ) {
5675: CZ(m1) = HCZ(p2); chsgnlf(HCZ(p1),&CZ(m2));
5676: } else if ( nd_vc ) {
5677: ezgcdpz(nd_vc,HCP(p1),HCP(p2),&gp);
5678: divsp(nd_vc,HCP(p2),gp,&CP(m1));
5679: divsp(nd_vc,HCP(p1),gp,&tp); chsgnp(tp,&CP(m2));
5680: } else {
1.6 noro 5681: igcd_cofactor(HCZ(p1),HCZ(p2),&g,&t,&CZ(m1)); chsgnz(t,&CZ(m2));
1.1 noro 5682: }
5683: t1 = ndv_mul_nm(mod,m1,p1); t2 = ndv_mul_nm(mod,m2,p2);
5684: *rp = nd_add(mod,t1,t2);
5685: if ( nd_gentrace ) {
5686: /* nd_tracelist is initialized */
1.6 noro 5687: STOZ(p->i1,iq); nmtodp(mod,m1,&d); node = mknode(4,ONE,iq,d,ONE);
1.1 noro 5688: MKLIST(hist,node); MKNODE(nd_tracelist,hist,0);
1.6 noro 5689: STOZ(p->i2,iq); nmtodp(mod,m2,&d); node = mknode(4,ONE,iq,d,ONE);
1.1 noro 5690: MKLIST(hist,node); MKNODE(node,hist,nd_tracelist);
5691: nd_tracelist = node;
5692: }
1.24 noro 5693: if ( *rp )
5694: (*rp)->sig = p->sig;
1.1 noro 5695: FREENM(m1); FREENM(m2);
5696: return 1;
5697: }
5698:
5699: void ndv_mul_c(int mod,NDV p,int mul)
5700: {
5701: NMV m;
5702: int c,c1,len,i;
5703:
5704: if ( !p ) return;
5705: len = LEN(p);
5706: if ( mod == -1 )
5707: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) )
5708: CM(m) = _mulsf(CM(m),mul);
5709: else
5710: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
5711: c1 = CM(m); DMAR(c1,mul,0,mod,c); CM(m) = c;
5712: }
5713: }
5714:
5715: void ndv_mul_c_lf(NDV p,Z mul)
5716: {
5717: NMV m;
5718: Z c;
5719: int len,i;
5720:
5721: if ( !p ) return;
5722: len = LEN(p);
5723: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
5724: mullf(CZ(m),mul,&c); CZ(m) = c;
5725: }
5726: }
5727:
5728: /* for nd_det */
5729: void ndv_mul_c_q(NDV p,Z mul)
5730: {
5731: NMV m;
5732: Z c;
5733: int len,i;
5734:
5735: if ( !p ) return;
5736: len = LEN(p);
5737: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
1.6 noro 5738: mulz(CZ(m),mul,&c); CZ(m) = c;
1.1 noro 5739: }
5740: }
5741:
5742: ND weyl_ndv_mul_nm(int mod,NM m0,NDV p) {
5743: int n2,i,j,l,n,tlen;
5744: UINT *d0;
5745: NM *tab,*psum;
5746: ND s,r;
5747: NM t;
5748: NMV m1;
5749:
5750: if ( !p ) return 0;
5751: n = NV(p); n2 = n>>1;
5752: d0 = DL(m0);
5753: l = LEN(p);
5754: for ( i = 0, tlen = 1; i < n2; i++ ) tlen *= (GET_EXP(d0,n2+i)+1);
5755: tab = (NM *)MALLOC(tlen*sizeof(NM));
5756: psum = (NM *)MALLOC(tlen*sizeof(NM));
5757: for ( i = 0; i < tlen; i++ ) psum[i] = 0;
5758: m1 = (NMV)(((char *)BDY(p))+nmv_adv*(l-1));
5759: for ( i = l-1; i >= 0; i--, NMV_PREV(m1) ) {
5760: /* m0(NM) * m1(NMV) => tab(NM) */
5761: weyl_mul_nm_nmv(n,mod,m0,m1,tab,tlen);
5762: for ( j = 0; j < tlen; j++ ) {
5763: if ( tab[j] ) {
5764: NEXT(tab[j]) = psum[j]; psum[j] = tab[j];
5765: }
5766: }
5767: }
5768: for ( i = tlen-1, r = 0; i >= 0; i-- )
5769: if ( psum[i] ) {
5770: for ( j = 0, t = psum[i]; t; t = NEXT(t), j++ );
5771: MKND(n,psum[i],j,s);
5772: r = nd_add(mod,r,s);
5773: }
5774: if ( r ) SG(r) = SG(p)+TD(d0);
5775: return r;
5776: }
5777:
5778: /* product of monomials */
5779: /* XXX block order is not handled correctly */
5780:
5781: void weyl_mul_nm_nmv(int n,int mod,NM m0,NMV m1,NM *tab,int tlen)
5782: {
5783: int i,n2,j,s,curlen,homo,h,a,b,k,l,u,min;
5784: UINT *d0,*d1,*d,*dt,*ctab;
5785: Z *ctab_q;
5786: Z q,q1;
5787: UINT c0,c1,c;
5788: NM *p;
5789: NM m,t;
5790: int mpos;
5791:
5792: for ( i = 0; i < tlen; i++ ) tab[i] = 0;
5793: if ( !m0 || !m1 ) return;
5794: d0 = DL(m0); d1 = DL(m1); n2 = n>>1;
5795: if ( nd_module )
5796: if ( MPOS(d0) ) error("weyl_mul_nm_nmv : invalid operation");
5797:
5798: NEWNM(m); d = DL(m);
5799: if ( mod ) {
5800: c0 = CM(m0); c1 = CM(m1); DMAR(c0,c1,0,mod,c); CM(m) = c;
5801: } else if ( nd_vc )
5802: mulp(nd_vc,CP(m0),CP(m1),&CP(m));
5803: else
1.6 noro 5804: mulz(CZ(m0),CZ(m1),&CZ(m));
1.1 noro 5805: for ( i = 0; i < nd_wpd; i++ ) d[i] = 0;
5806: homo = n&1 ? 1 : 0;
5807: if ( homo ) {
5808: /* offset of h-degree */
5809: h = GET_EXP(d0,n-1)+GET_EXP(d1,n-1);
5810: PUT_EXP(DL(m),n-1,h);
5811: TD(DL(m)) = h;
5812: if ( nd_blockmask ) ndl_weight_mask(DL(m));
5813: }
5814: tab[0] = m;
5815: NEWNM(m); d = DL(m);
5816: for ( i = 0, curlen = 1; i < n2; i++ ) {
5817: a = GET_EXP(d0,i); b = GET_EXP(d1,n2+i);
5818: k = GET_EXP(d0,n2+i); l = GET_EXP(d1,i);
5819: /* xi^a*(Di^k*xi^l)*Di^b */
5820: a += l; b += k;
5821: s = MUL_WEIGHT(a,i)+MUL_WEIGHT(b,n2+i);
5822: if ( !k || !l ) {
5823: for ( j = 0; j < curlen; j++ )
5824: if ( (t = tab[j]) != 0 ) {
5825: dt = DL(t);
5826: PUT_EXP(dt,i,a); PUT_EXP(dt,n2+i,b); TD(dt) += s;
5827: if ( nd_blockmask ) ndl_weight_mask(dt);
5828: }
5829: curlen *= k+1;
5830: continue;
5831: }
5832: min = MIN(k,l);
5833: if ( mod ) {
5834: ctab = (UINT *)MALLOC((min+1)*sizeof(UINT));
5835: mkwcm(k,l,mod,(int *)ctab);
5836: } else {
5837: ctab_q = (Z *)MALLOC((min+1)*sizeof(Z));
5838: mkwc(k,l,ctab_q);
5839: }
5840: for ( j = min; j >= 0; j-- ) {
5841: for ( u = 0; u < nd_wpd; u++ ) d[u] = 0;
5842: PUT_EXP(d,i,a-j); PUT_EXP(d,n2+i,b-j);
5843: h = MUL_WEIGHT(a-j,i)+MUL_WEIGHT(b-j,n2+i);
5844: if ( homo ) {
5845: TD(d) = s;
5846: PUT_EXP(d,n-1,s-h);
5847: } else TD(d) = h;
5848: if ( nd_blockmask ) ndl_weight_mask(d);
5849: if ( mod ) c = ctab[j];
5850: else q = ctab_q[j];
5851: p = tab+curlen*j;
5852: if ( j == 0 ) {
5853: for ( u = 0; u < curlen; u++, p++ ) {
5854: if ( tab[u] ) {
5855: ndl_addto(DL(tab[u]),d);
5856: if ( mod ) {
5857: c0 = CM(tab[u]); DMAR(c0,c,0,mod,c1); CM(tab[u]) = c1;
5858: } else if ( nd_vc )
5859: mulp(nd_vc,CP(tab[u]),(P)q,&CP(tab[u]));
5860: else {
1.6 noro 5861: mulz(CZ(tab[u]),q,&q1); CZ(tab[u]) = q1;
1.1 noro 5862: }
5863: }
5864: }
5865: } else {
5866: for ( u = 0; u < curlen; u++, p++ ) {
5867: if ( tab[u] ) {
5868: NEWNM(t);
5869: ndl_add(DL(tab[u]),d,DL(t));
5870: if ( mod ) {
5871: c0 = CM(tab[u]); DMAR(c0,c,0,mod,c1); CM(t) = c1;
5872: } else if ( nd_vc )
5873: mulp(nd_vc,CP(tab[u]),(P)q,&CP(t));
5874: else
1.6 noro 5875: mulz(CZ(tab[u]),q,&CZ(t));
1.1 noro 5876: *p = t;
5877: }
5878: }
5879: }
5880: }
5881: curlen *= k+1;
5882: }
5883: FREENM(m);
5884: if ( nd_module ) {
5885: mpos = MPOS(d1);
5886: for ( i = 0; i < tlen; i++ )
5887: if ( tab[i] ) {
5888: d = DL(tab[i]);
5889: MPOS(d) = mpos;
5890: TD(d) = ndl_weight(d);
5891: }
5892: }
5893: }
5894:
5895: ND ndv_mul_nm_symbolic(NM m0,NDV p)
5896: {
5897: NM mr,mr0;
5898: NMV m;
5899: UINT *d,*dt,*dm;
5900: int c,n,td,i,c1,c2,len;
5901: Q q;
5902: ND r;
5903:
5904: if ( !p ) return 0;
5905: else {
5906: n = NV(p); m = BDY(p);
5907: d = DL(m0);
5908: len = LEN(p);
5909: mr0 = 0;
5910: td = TD(d);
5911: c = CM(m0);
5912: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5913: NEXTNM(mr0,mr);
5914: CM(mr) = 1;
5915: ndl_add(DL(m),d,DL(mr));
5916: }
5917: NEXT(mr) = 0;
5918: MKND(NV(p),mr0,len,r);
5919: SG(r) = SG(p) + TD(d);
5920: return r;
5921: }
5922: }
5923:
5924: ND ndv_mul_nm(int mod,NM m0,NDV p)
5925: {
5926: NM mr,mr0;
5927: NMV m;
5928: UINT *d,*dt,*dm;
5929: int c,n,td,i,c1,c2,len;
5930: P q;
5931: ND r;
5932:
5933: if ( !p ) return 0;
5934: else if ( do_weyl ) {
5935: if ( mod < 0 ) {
5936: error("ndv_mul_nm : not implemented (weyl)");
5937: return 0;
5938: } else
5939: return weyl_ndv_mul_nm(mod,m0,p);
5940: } else {
5941: n = NV(p); m = BDY(p);
5942: d = DL(m0);
5943: len = LEN(p);
5944: mr0 = 0;
5945: td = TD(d);
5946: if ( mod == -1 ) {
5947: c = CM(m0);
5948: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5949: NEXTNM(mr0,mr);
5950: CM(mr) = _mulsf(CM(m),c);
5951: ndl_add(DL(m),d,DL(mr));
5952: }
5953: } else if ( mod == -2 ) {
5954: Z cl;
5955: cl = CZ(m0);
5956: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5957: NEXTNM(mr0,mr);
5958: mullf(CZ(m),cl,&CZ(mr));
5959: ndl_add(DL(m),d,DL(mr));
5960: }
5961: } else if ( mod ) {
5962: c = CM(m0);
5963: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5964: NEXTNM(mr0,mr);
5965: c1 = CM(m);
5966: DMAR(c1,c,0,mod,c2);
5967: CM(mr) = c2;
5968: ndl_add(DL(m),d,DL(mr));
5969: }
5970: } else {
5971: q = CP(m0);
5972: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5973: NEXTNM(mr0,mr);
5974: mulp(nd_vc,CP(m),q,&CP(mr));
5975: ndl_add(DL(m),d,DL(mr));
5976: }
5977: }
5978: NEXT(mr) = 0;
5979: MKND(NV(p),mr0,len,r);
5980: SG(r) = SG(p) + TD(d);
5981: return r;
5982: }
5983: }
5984:
5985: ND nd_quo(int mod,PGeoBucket bucket,NDV d)
5986: {
5987: NM mq0,mq;
5988: NMV tm;
5989: Q q;
5990: int i,nv,sg,c,c1,c2,hindex;
5991: ND p,t,r;
5992:
5993: if ( bucket->m < 0 ) return 0;
5994: else {
5995: nv = NV(d);
5996: mq0 = 0;
5997: tm = (NMV)MALLOC(nmv_adv);
5998: while ( 1 ) {
5999: if ( mod > 0 || mod == -1 )
6000: hindex = head_pbucket(mod,bucket);
6001: else if ( mod == -2 )
6002: hindex = head_pbucket_lf(bucket);
6003: else
6004: hindex = head_pbucket_q(bucket);
6005: if ( hindex < 0 ) break;
6006: p = bucket->body[hindex];
6007: NEXTNM(mq0,mq);
6008: ndl_sub(HDL(p),HDL(d),DL(mq));
6009: ndl_copy(DL(mq),DL(tm));
6010: if ( mod ) {
6011: c1 = invm(HCM(d),mod); c2 = HCM(p);
6012: DMAR(c1,c2,0,mod,c); CM(mq) = c;
6013: CM(tm) = mod-c;
6014: } else {
1.6 noro 6015: divsz(HCZ(p),HCZ(d),&CZ(mq));
6016: chsgnz(CZ(mq),&CZ(tm));
1.1 noro 6017: }
6018: t = ndv_mul_nmv_trunc(mod,tm,d,HDL(d));
6019: bucket->body[hindex] = nd_remove_head(p);
6020: t = nd_remove_head(t);
6021: add_pbucket(mod,bucket,t);
6022: }
6023: if ( !mq0 )
6024: r = 0;
6025: else {
6026: NEXT(mq) = 0;
6027: for ( i = 0, mq = mq0; mq; mq = NEXT(mq), i++ );
6028: MKND(nv,mq0,i,r);
6029: /* XXX */
6030: SG(r) = HTD(r);
6031: }
6032: return r;
6033: }
6034: }
6035:
6036: void ndv_realloc(NDV p,int obpe,int oadv,EPOS oepos)
6037: {
6038: NMV m,mr,mr0,t;
6039: int len,i,k;
6040:
6041: if ( !p ) return;
6042: m = BDY(p); len = LEN(p);
6043: mr0 = nmv_adv>oadv?(NMV)REALLOC(BDY(p),len*nmv_adv):BDY(p);
6044: m = (NMV)((char *)mr0+(len-1)*oadv);
6045: mr = (NMV)((char *)mr0+(len-1)*nmv_adv);
6046: t = (NMV)MALLOC(nmv_adv);
6047: for ( i = 0; i < len; i++, NMV_OPREV(m), NMV_PREV(mr) ) {
1.6 noro 6048: CZ(t) = CZ(m);
1.1 noro 6049: for ( k = 0; k < nd_wpd; k++ ) DL(t)[k] = 0;
6050: ndl_reconstruct(DL(m),DL(t),obpe,oepos);
1.6 noro 6051: CZ(mr) = CZ(t);
1.1 noro 6052: ndl_copy(DL(t),DL(mr));
6053: }
6054: BDY(p) = mr0;
6055: }
6056:
6057: NDV ndv_dup_realloc(NDV p,int obpe,int oadv,EPOS oepos)
6058: {
6059: NMV m,mr,mr0;
6060: int len,i;
6061: NDV r;
6062:
6063: if ( !p ) return 0;
6064: m = BDY(p); len = LEN(p);
6065: mr0 = mr = (NMV)MALLOC(len*nmv_adv);
6066: for ( i = 0; i < len; i++, NMV_OADV(m), NMV_ADV(mr) ) {
6067: ndl_zero(DL(mr));
6068: ndl_reconstruct(DL(m),DL(mr),obpe,oepos);
1.6 noro 6069: CZ(mr) = CZ(m);
1.1 noro 6070: }
6071: MKNDV(NV(p),mr0,len,r);
6072: SG(r) = SG(p);
1.24 noro 6073: r->sig = p->sig;
1.1 noro 6074: return r;
6075: }
6076:
6077: /* duplicate p */
6078:
6079: NDV ndv_dup(int mod,NDV p)
6080: {
6081: NDV d;
6082: NMV t,m,m0;
6083: int i,len;
6084:
6085: if ( !p ) return 0;
6086: len = LEN(p);
6087: m0 = m = (NMV)((mod>0 || mod==-1)?MALLOC_ATOMIC(len*nmv_adv):MALLOC(len*nmv_adv));
6088: for ( t = BDY(p), i = 0; i < len; i++, NMV_ADV(t), NMV_ADV(m) ) {
6089: ndl_copy(DL(t),DL(m));
1.6 noro 6090: CZ(m) = CZ(t);
1.1 noro 6091: }
6092: MKNDV(NV(p),m0,len,d);
6093: SG(d) = SG(p);
6094: return d;
6095: }
6096:
6097: NDV ndv_symbolic(int mod,NDV p)
6098: {
6099: NDV d;
6100: NMV t,m,m0;
6101: int i,len;
6102:
6103: if ( !p ) return 0;
6104: len = LEN(p);
6105: m0 = m = (NMV)((mod>0||mod==-1)?MALLOC_ATOMIC(len*nmv_adv):MALLOC(len*nmv_adv));
6106: for ( t = BDY(p), i = 0; i < len; i++, NMV_ADV(t), NMV_ADV(m) ) {
6107: ndl_copy(DL(t),DL(m));
1.6 noro 6108: CZ(m) = ONE;
1.1 noro 6109: }
6110: MKNDV(NV(p),m0,len,d);
6111: SG(d) = SG(p);
6112: return d;
6113: }
6114:
6115: ND nd_dup(ND p)
6116: {
6117: ND d;
6118: NM t,m,m0;
6119:
6120: if ( !p ) return 0;
6121: for ( m0 = 0, t = BDY(p); t; t = NEXT(t) ) {
6122: NEXTNM(m0,m);
6123: ndl_copy(DL(t),DL(m));
1.6 noro 6124: CZ(m) = CZ(t);
1.1 noro 6125: }
6126: if ( m0 ) NEXT(m) = 0;
6127: MKND(NV(p),m0,LEN(p),d);
6128: SG(d) = SG(p);
6129: return d;
6130: }
6131:
6132: /* XXX if p->len == 0 then it represents 0 */
6133:
6134: void ndv_mod(int mod,NDV p)
6135: {
6136: NMV t,d;
6137: int r,s,u;
6138: int i,len,dlen;
6139: P cp;
6140: Z c;
6141: Obj gfs;
6142:
6143: if ( !p ) return;
6144: len = LEN(p);
6145: dlen = 0;
6146: if ( mod == -1 )
6147: for ( t = d = BDY(p), i = 0; i < len; i++, NMV_ADV(t) ) {
6148: simp_ff((Obj)CP(t),&gfs);
6149: if ( gfs ) {
6150: r = FTOIF(CONT((GFS)gfs));
6151: CM(d) = r;
6152: ndl_copy(DL(t),DL(d));
6153: NMV_ADV(d);
6154: dlen++;
6155: }
6156: }
6157: else if ( mod == -2 )
6158: for ( t = d = BDY(p), i = 0; i < len; i++, NMV_ADV(t) ) {
6159: simp_ff((Obj)CP(t),&gfs);
6160: if ( gfs ) {
6161: lmtolf((LM)gfs,&CZ(d));
6162: ndl_copy(DL(t),DL(d));
6163: NMV_ADV(d);
6164: dlen++;
6165: }
6166: }
6167: else
6168: for ( t = d = BDY(p), i = 0; i < len; i++, NMV_ADV(t) ) {
6169: if ( nd_vc ) {
6170: nd_subst_vector(nd_vc,CP(t),nd_subst,&cp);
6171: c = (Z)cp;
6172: } else
1.6 noro 6173: c = CZ(t);
1.1 noro 6174: r = remqi((Q)c,mod);
6175: if ( r ) {
6176: CM(d) = r;
6177: ndl_copy(DL(t),DL(d));
6178: NMV_ADV(d);
6179: dlen++;
6180: }
6181: }
6182: LEN(p) = dlen;
6183: }
6184:
6185: NDV ptondv(VL vl,VL dvl,P p)
6186: {
6187: ND nd;
6188:
6189: nd = ptond(vl,dvl,p);
6190: return ndtondv(0,nd);
6191: }
6192:
6193: void pltozpl(LIST l,Q *cont,LIST *pp)
6194: {
1.16 noro 6195: NODE nd,nd1;
6196: int n;
6197: P *pl;
6198: Q *cl;
6199: int i;
6200: P dmy;
6201: Z dvr,inv;
6202: LIST r;
6203:
6204: nd = BDY(l); n = length(nd);
6205: pl = (P *)MALLOC(n*sizeof(P));
6206: cl = (Q *)MALLOC(n*sizeof(Q));
6207: for ( i = 0; i < n; i++, nd = NEXT(nd) ) {
6208: ptozp((P)BDY(nd),1,&cl[i],&dmy);
6209: }
6210: qltozl(cl,n,&dvr);
6211: divz(ONE,dvr,&inv);
6212: nd = BDY(l);
6213: for ( i = 0; i < n; i++, nd = NEXT(nd) )
6214: divsp(CO,(P)BDY(nd),(P)dvr,&pl[i]);
6215: nd = 0;
6216: for ( i = n-1; i >= 0; i-- ) {
6217: MKNODE(nd1,pl[i],nd); nd = nd1;
6218: }
6219: MKLIST(r,nd);
6220: *pp = r;
1.1 noro 6221: }
6222:
6223: /* (a1,a2,...,an) -> a1*e(1)+...+an*e(n) */
6224:
6225: NDV pltondv(VL vl,VL dvl,LIST p)
6226: {
6227: int i;
6228: NODE t;
6229: ND r,ri;
6230: NM m;
6231:
6232: if ( !nd_module ) error("pltond : module order must be set");
6233: r = 0;
6234: for ( i = 1, t = BDY(p); t; t = NEXT(t), i++ ) {
6235: ri = ptond(vl,dvl,(P)BDY(t));
6236: if ( ri )
6237: for ( m = BDY(ri); m; m = NEXT(m) ) {
6238: MPOS(DL(m)) = i;
6239: TD(DL(m)) = ndl_weight(DL(m));
6240: if ( nd_blockmask ) ndl_weight_mask(DL(m));
6241: }
6242: r = nd_add(0,r,ri);
6243: }
6244: return ndtondv(0,r);
6245: }
6246:
6247: ND ptond(VL vl,VL dvl,P p)
6248: {
6249: int n,i,j,k,e;
6250: VL tvl;
6251: V v;
6252: DCP dc;
6253: DCP *w;
6254: ND r,s,t,u;
6255: P x;
6256: int c;
6257: UINT *d;
6258: NM m,m0;
6259:
6260: if ( !p )
6261: return 0;
6262: else if ( NUM(p) ) {
6263: NEWNM(m);
6264: ndl_zero(DL(m));
6265: if ( !INT((Q)p) )
6266: error("ptond : input must be integer-coefficient");
1.6 noro 6267: CZ(m) = (Z)p;
1.1 noro 6268: NEXT(m) = 0;
6269: MKND(nd_nvar,m,1,r);
6270: SG(r) = 0;
6271: return r;
6272: } else {
6273: for ( dc = DC(p), k = 0; dc; dc = NEXT(dc), k++ );
6274: w = (DCP *)MALLOC(k*sizeof(DCP));
6275: for ( dc = DC(p), j = 0; j < k; dc = NEXT(dc), j++ ) w[j] = dc;
6276: for ( i = 0, tvl = dvl, v = VR(p);
6277: tvl && tvl->v != v; tvl = NEXT(tvl), i++ );
6278: if ( !tvl ) {
6279: for ( j = k-1, s = 0, MKV(v,x); j >= 0; j-- ) {
6280: t = ptond(vl,dvl,COEF(w[j]));
6281: pwrp(vl,x,DEG(w[j]),&p);
6282: nd_mul_c_p(CO,t,p); s = nd_add(0,s,t);
6283: }
6284: return s;
6285: } else {
6286: NEWNM(m0); d = DL(m0);
6287: for ( j = k-1, s = 0; j >= 0; j-- ) {
1.6 noro 6288: ndl_zero(d); e = ZTOS(DEG(w[j])); PUT_EXP(d,i,e);
1.1 noro 6289: TD(d) = MUL_WEIGHT(e,i);
6290: if ( nd_blockmask) ndl_weight_mask(d);
6291: if ( nd_module ) MPOS(d) = 0;
6292: t = ptond(vl,dvl,COEF(w[j]));
6293: for ( m = BDY(t); m; m = NEXT(m) )
6294: ndl_addto(DL(m),d);
6295: SG(t) += TD(d);
6296: s = nd_add(0,s,t);
6297: }
6298: FREENM(m0);
6299: return s;
6300: }
6301: }
6302: }
6303:
6304: P ndvtop(int mod,VL vl,VL dvl,NDV p)
6305: {
6306: VL tvl;
6307: int len,n,j,i,e;
6308: NMV m;
6309: Z q;
6310: P c;
6311: UINT *d;
6312: P s,r,u,t,w;
6313: GFS gfs;
6314:
6315: if ( !p ) return 0;
6316: else {
6317: len = LEN(p);
6318: n = NV(p);
6319: m = (NMV)(((char *)BDY(p))+nmv_adv*(len-1));
6320: for ( j = len-1, s = 0; j >= 0; j--, NMV_PREV(m) ) {
6321: if ( mod == -1 ) {
6322: e = IFTOF(CM(m)); MKGFS(e,gfs); c = (P)gfs;
6323: } else if ( mod == -2 ) {
6324: c = (P)CZ(m);
6325: } else if ( mod > 0 ) {
1.6 noro 6326: STOZ(CM(m),q); c = (P)q;
1.1 noro 6327: } else
6328: c = CP(m);
6329: d = DL(m);
6330: for ( i = 0, t = c, tvl = dvl; i < n; tvl = NEXT(tvl), i++ ) {
1.6 noro 6331: MKV(tvl->v,r); e = GET_EXP(d,i); STOZ(e,q);
1.1 noro 6332: pwrp(vl,r,q,&u); mulp(vl,t,u,&w); t = w;
6333: }
6334: addp(vl,s,t,&u); s = u;
6335: }
6336: return s;
6337: }
6338: }
6339:
6340: LIST ndvtopl(int mod,VL vl,VL dvl,NDV p,int rank)
6341: {
6342: VL tvl;
6343: int len,n,j,i,e;
6344: NMV m;
6345: Z q;
6346: P c;
6347: UINT *d;
6348: P s,r,u,t,w;
6349: GFS gfs;
6350: P *a;
6351: LIST l;
6352: NODE nd,nd1;
6353:
6354: if ( !p ) return 0;
6355: else {
6356: a = (P *)MALLOC((rank+1)*sizeof(P));
6357: for ( i = 0; i <= rank; i++ ) a[i] = 0;
6358: len = LEN(p);
6359: n = NV(p);
6360: m = (NMV)(((char *)BDY(p))+nmv_adv*(len-1));
6361: for ( j = len-1; j >= 0; j--, NMV_PREV(m) ) {
6362: if ( mod == -1 ) {
6363: e = IFTOF(CM(m)); MKGFS(e,gfs); c = (P)gfs;
6364: } else if ( mod ) {
1.6 noro 6365: STOZ(CM(m),q); c = (P)q;
1.1 noro 6366: } else
6367: c = CP(m);
6368: d = DL(m);
6369: for ( i = 0, t = c, tvl = dvl; i < n; tvl = NEXT(tvl), i++ ) {
1.6 noro 6370: MKV(tvl->v,r); e = GET_EXP(d,i); STOZ(e,q);
1.1 noro 6371: pwrp(vl,r,q,&u); mulp(vl,t,u,&w); t = w;
6372: }
6373: addp(vl,a[MPOS(d)],t,&u); a[MPOS(d)] = u;
6374: }
6375: nd = 0;
6376: for ( i = rank; i > 0; i-- ) {
6377: MKNODE(nd1,a[i],nd); nd = nd1;
6378: }
6379: MKLIST(l,nd);
6380: return l;
6381: }
6382: }
6383:
6384: NDV ndtondv(int mod,ND p)
6385: {
6386: NDV d;
6387: NMV m,m0;
6388: NM t;
6389: int i,len;
6390:
6391: if ( !p ) return 0;
6392: len = LEN(p);
6393: if ( mod > 0 || mod == -1 )
6394: m0 = m = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(len*nmv_adv);
6395: else
6396: m0 = m = MALLOC(len*nmv_adv);
6397: #if 0
6398: ndv_alloc += nmv_adv*len;
6399: #endif
6400: for ( t = BDY(p), i = 0; t; t = NEXT(t), i++, NMV_ADV(m) ) {
6401: ndl_copy(DL(t),DL(m));
1.6 noro 6402: CZ(m) = CZ(t);
1.1 noro 6403: }
6404: MKNDV(NV(p),m0,len,d);
6405: SG(d) = SG(p);
1.24 noro 6406: d->sig = p->sig;
1.1 noro 6407: return d;
6408: }
6409:
1.16 noro 6410: static int dmm_comp_nv;
6411:
6412: int dmm_comp(DMM *a,DMM *b)
6413: {
6414: return -compdmm(dmm_comp_nv,*a,*b);
6415: }
6416:
6417: void dmm_sort_by_ord(DMM *a,int len,int nv)
6418: {
6419: dmm_comp_nv = nv;
6420: qsort(a,len,sizeof(DMM),(int (*)(const void *,const void *))dmm_comp);
6421: }
6422:
6423: void dpm_sort(DPM p,DPM *rp)
6424: {
6425: DMM t,t1;
6426: int len,i,n;
6427: DMM *a;
6428: DPM d;
6429:
6430: if ( !p ) *rp = 0;
6431: for ( t = BDY(p), len = 0; t; t = NEXT(t), len++ );
6432: a = (DMM *)MALLOC(len*sizeof(DMM));
6433: for ( i = 0, t = BDY(p); i < len; i++, t = NEXT(t) ) a[i] = t;
6434: n = p->nv;
6435: dmm_sort_by_ord(a,len,n);
6436: t = 0;
6437: for ( i = len-1; i >= 0; i-- ) {
6438: NEWDMM(t1);
6439: t1->c = a[i]->c;
6440: t1->dl = a[i]->dl;
6441: t1->pos = a[i]->pos;
6442: t1->next = t;
6443: t = t1;
6444: }
6445: MKDPM(n,t,d);
6446: SG(d) = SG(p);
6447: *rp = d;
6448: }
6449:
1.18 noro 6450: int dpm_comp(DPM *a,DPM *b)
6451: {
1.22 noro 6452: return -compdpm(CO,*a,*b);
1.18 noro 6453: }
6454:
6455: NODE dpm_sort_list(NODE l)
6456: {
6457: int i,len;
6458: NODE t,t1;
6459: DPM *a;
6460:
6461: len = length(l);
6462: a = (DPM *)MALLOC(len*sizeof(DPM));
6463: for ( t = l, i = 0; i < len; i++, t = NEXT(t) ) a[i] = (DPM)BDY(t);
6464: qsort(a,len,sizeof(DPM),(int (*)(const void *,const void *))dpm_comp);
6465: t = 0;
6466: for ( i = len-1; i >= 0; i-- ) {
6467: MKNODE(t1,(pointer)a[i],t); t = t1;
6468: }
6469: return t;
6470: }
6471:
1.20 noro 6472: int nmv_comp(NMV a,NMV b)
6473: {
1.21 noro 6474: int t;
6475: t = DL_COMPARE(a->dl,b->dl);
6476: return -t;
1.20 noro 6477: }
6478:
1.16 noro 6479: NDV dpmtondv(int mod,DPM p)
6480: {
6481: NDV d;
6482: NMV m,m0;
6483: DMM t;
6484: DMM *a;
6485: int i,len,n;
6486:
6487: if ( !p ) return 0;
6488: for ( t = BDY(p), len = 0; t; t = NEXT(t), len++ );
6489: a = (DMM *)MALLOC(len*sizeof(DMM));
6490: for ( i = 0, t = BDY(p); i < len; i++, t = NEXT(t) ) a[i] = t;
6491: n = p->nv;
6492: dmm_sort_by_ord(a,len,n);
6493: if ( mod > 0 || mod == -1 )
6494: m0 = m = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(len*nmv_adv);
6495: else
6496: m0 = m = MALLOC(len*nmv_adv);
6497: #if 0
6498: ndv_alloc += nmv_adv*len;
6499: #endif
6500: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
6501: dltondl(n,a[i]->dl,DL(m));
6502: MPOS(DL(m)) = a[i]->pos;
1.20 noro 6503: TD(DL(m)) = ndl_weight(DL(m));
1.16 noro 6504: CZ(m) = (Z)a[i]->c;
6505: }
1.20 noro 6506: qsort(m0,len,nmv_adv,(int (*)(const void *,const void *))nmv_comp);
1.16 noro 6507: MKNDV(NV(p),m0,len,d);
6508: SG(d) = SG(p);
6509: return d;
6510: }
6511:
1.1 noro 6512: ND ndvtond(int mod,NDV p)
6513: {
6514: ND d;
6515: NM m,m0;
6516: NMV t;
6517: int i,len;
6518:
6519: if ( !p ) return 0;
6520: m0 = 0;
6521: len = p->len;
6522: for ( t = BDY(p), i = 0; i < len; NMV_ADV(t), i++ ) {
6523: NEXTNM(m0,m);
6524: ndl_copy(DL(t),DL(m));
1.6 noro 6525: CZ(m) = CZ(t);
1.1 noro 6526: }
6527: NEXT(m) = 0;
6528: MKND(NV(p),m0,len,d);
6529: SG(d) = SG(p);
1.28 noro 6530: d->sig = p->sig;
1.1 noro 6531: return d;
6532: }
6533:
6534: DP ndvtodp(int mod,NDV p)
6535: {
6536: MP m,m0;
6537: DP d;
6538: NMV t;
6539: int i,len;
6540:
6541: if ( !p ) return 0;
6542: m0 = 0;
6543: len = p->len;
6544: for ( t = BDY(p), i = 0; i < len; NMV_ADV(t), i++ ) {
6545: NEXTMP(m0,m);
6546: m->dl = ndltodl(nd_nvar,DL(t));
6547: m->c = (Obj)ndctop(mod,t->c);
6548: }
6549: NEXT(m) = 0;
6550: MKDP(nd_nvar,m0,d);
6551: SG(d) = SG(p);
6552: return d;
6553: }
6554:
1.16 noro 6555: DPM ndvtodpm(int mod,NDV p)
6556: {
6557: DMM m,m0;
6558: DPM d;
6559: NMV t;
6560: int i,len;
6561:
6562: if ( !p ) return 0;
6563: m0 = 0;
6564: len = p->len;
6565: for ( t = BDY(p), i = 0; i < len; NMV_ADV(t), i++ ) {
6566: NEXTDMM(m0,m);
6567: m->dl = ndltodl(nd_nvar,DL(t));
6568: m->c = (Obj)ndctop(mod,t->c);
6569: m->pos = MPOS(DL(t));
6570: }
6571: NEXT(m) = 0;
6572: MKDPM(nd_nvar,m0,d);
6573: SG(d) = SG(p);
6574: return d;
6575: }
6576:
6577:
1.1 noro 6578: DP ndtodp(int mod,ND p)
6579: {
6580: MP m,m0;
6581: DP d;
6582: NM t;
6583: int i,len;
6584:
6585: if ( !p ) return 0;
6586: m0 = 0;
6587: len = p->len;
6588: for ( t = BDY(p); t; t = NEXT(t) ) {
6589: NEXTMP(m0,m);
6590: m->dl = ndltodl(nd_nvar,DL(t));
6591: m->c = (Obj)ndctop(mod,t->c);
6592: }
6593: NEXT(m) = 0;
6594: MKDP(nd_nvar,m0,d);
6595: SG(d) = SG(p);
6596: return d;
6597: }
6598:
6599: void ndv_print(NDV p)
6600: {
6601: NMV m;
6602: int i,len;
6603:
6604: if ( !p ) printf("0\n");
6605: else {
6606: len = LEN(p);
6607: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
6608: if ( CM(m) & 0x80000000 ) printf("+@_%d*",IFTOF(CM(m)));
1.28 noro 6609: else printf("+%ld*",CM(m));
1.1 noro 6610: ndl_print(DL(m));
6611: }
6612: printf("\n");
6613: }
6614: }
6615:
6616: void ndv_print_q(NDV p)
6617: {
6618: NMV m;
6619: int i,len;
6620:
6621: if ( !p ) printf("0\n");
6622: else {
6623: len = LEN(p);
6624: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
6625: printf("+");
1.6 noro 6626: printexpr(CO,(Obj)CZ(m));
1.1 noro 6627: printf("*");
6628: ndl_print(DL(m));
6629: }
6630: printf("\n");
6631: }
6632: }
6633:
6634: NODE ndv_reducebase(NODE x,int *perm)
6635: {
6636: int len,i,j;
6637: NDVI w;
6638: NODE t,t0;
6639:
6640: len = length(x);
6641: w = (NDVI)MALLOC(len*sizeof(struct oNDVI));
6642: for ( i = 0, t = x; i < len; i++, t = NEXT(t) ) {
6643: w[i].p = BDY(t); w[i].i = perm[i];
6644: }
6645: for ( i = 0; i < len; i++ ) {
6646: for ( j = 0; j < i; j++ ) {
6647: if ( w[i].p && w[j].p ) {
6648: if ( ndl_reducible(HDL(w[i].p),HDL(w[j].p)) ) w[i].p = 0;
6649: else if ( ndl_reducible(HDL(w[j].p),HDL(w[i].p)) ) w[j].p = 0;
6650: }
6651: }
6652: }
6653: for ( i = j = 0, t0 = 0; i < len; i++ ) {
6654: if ( w[i].p ) {
6655: NEXTNODE(t0,t); BDY(t) = (pointer)w[i].p;
6656: perm[j++] = w[i].i;
6657: }
6658: }
6659: NEXT(t) = 0; x = t0;
6660: return x;
6661: }
6662:
6663: /* XXX incomplete */
6664:
1.21 noro 6665: extern DMMstack dmm_stack;
6666: int ndl_module_schreyer_compare(UINT *a,UINT *b);
1.16 noro 6667:
1.1 noro 6668: void nd_init_ord(struct order_spec *ord)
6669: {
6670: nd_module = (ord->id >= 256);
6671: if ( nd_module ) {
6672: nd_dcomp = -1;
1.21 noro 6673: nd_module_ordtype = ord->module_ordtype;
1.1 noro 6674: nd_pot_nelim = ord->pot_nelim;
6675: nd_poly_weight_len = ord->nv;
6676: nd_poly_weight = ord->top_weight;
6677: nd_module_rank = ord->module_rank;
6678: nd_module_weight = ord->module_top_weight;
6679: }
6680: nd_matrix = 0;
6681: nd_matrix_len = 0;
6682: switch ( ord->id ) {
6683: case 0:
6684: switch ( ord->ord.simple ) {
6685: case 0:
6686: nd_dcomp = 1;
6687: nd_isrlex = 1;
6688: break;
6689: case 1:
6690: nd_dcomp = 1;
6691: nd_isrlex = 0;
6692: break;
6693: case 2:
6694: nd_dcomp = 0;
6695: nd_isrlex = 0;
6696: ndl_compare_function = ndl_lex_compare;
6697: break;
6698: case 11:
6699: /* XXX */
6700: nd_dcomp = 0;
6701: nd_isrlex = 1;
6702: ndl_compare_function = ndl_ww_lex_compare;
6703: break;
6704: default:
6705: error("nd_gr : unsupported order");
6706: }
6707: break;
6708: case 1:
6709: /* block order */
6710: /* XXX */
6711: nd_dcomp = -1;
6712: nd_isrlex = 0;
6713: ndl_compare_function = ndl_block_compare;
6714: break;
6715: case 2:
6716: /* matrix order */
6717: /* XXX */
6718: nd_dcomp = -1;
6719: nd_isrlex = 0;
6720: nd_matrix_len = ord->ord.matrix.row;
6721: nd_matrix = ord->ord.matrix.matrix;
6722: ndl_compare_function = ndl_matrix_compare;
6723: break;
6724: case 3:
6725: /* composite order */
6726: nd_dcomp = -1;
6727: nd_isrlex = 0;
6728: nd_worb_len = ord->ord.composite.length;
6729: nd_worb = ord->ord.composite.w_or_b;
6730: ndl_compare_function = ndl_composite_compare;
6731: break;
6732:
6733: /* module order */
6734: case 256:
6735: switch ( ord->ord.simple ) {
6736: case 0:
1.21 noro 6737: nd_dcomp = 0;
1.1 noro 6738: nd_isrlex = 1;
1.21 noro 6739: ndl_compare_function = ndl_module_glex_compare;
1.1 noro 6740: break;
6741: case 1:
1.21 noro 6742: nd_dcomp = 0;
1.1 noro 6743: nd_isrlex = 0;
6744: ndl_compare_function = ndl_module_glex_compare;
6745: break;
6746: case 2:
1.21 noro 6747: nd_dcomp = 0;
1.1 noro 6748: nd_isrlex = 0;
1.21 noro 6749: ndl_compare_function = ndl_module_compare;
6750: ndl_base_compare_function = ndl_lex_compare;
1.1 noro 6751: break;
6752: default:
1.21 noro 6753: error("nd_init_ord : unsupported order");
1.1 noro 6754: }
6755: break;
6756: case 257:
6757: /* block order */
6758: nd_isrlex = 0;
1.21 noro 6759: ndl_compare_function = ndl_module_compare;
6760: ndl_base_compare_function = ndl_block_compare;
1.1 noro 6761: break;
6762: case 258:
6763: /* matrix order */
6764: nd_isrlex = 0;
6765: nd_matrix_len = ord->ord.matrix.row;
6766: nd_matrix = ord->ord.matrix.matrix;
1.21 noro 6767: ndl_compare_function = ndl_module_compare;
6768: ndl_base_compare_function = ndl_matrix_compare;
1.1 noro 6769: break;
6770: case 259:
6771: /* composite order */
6772: nd_isrlex = 0;
6773: nd_worb_len = ord->ord.composite.length;
6774: nd_worb = ord->ord.composite.w_or_b;
1.21 noro 6775: ndl_compare_function = ndl_module_compare;
6776: ndl_base_compare_function = ndl_composite_compare;
6777: break;
6778: case 300:
6779: /* schreyer order */
6780: if ( ord->base->id != 256 )
6781: error("nd_init_ord : unsupported base order");
6782: ndl_compare_function = ndl_module_schreyer_compare;
6783: dmm_stack = ord->dmmstack;
6784: switch ( ord->base->ord.simple ) {
6785: case 0:
6786: nd_isrlex = 1;
6787: ndl_base_compare_function = ndl_glex_compare;
6788: dl_base_compare_function = cmpdl_revgradlex;
6789: break;
6790: case 1:
6791: nd_isrlex = 0;
6792: ndl_base_compare_function = ndl_glex_compare;
6793: dl_base_compare_function = cmpdl_gradlex;
6794: break;
6795: case 2:
6796: nd_isrlex = 0;
6797: ndl_base_compare_function = ndl_lex_compare;
6798: dl_base_compare_function = cmpdl_lex;
6799: break;
6800: default:
6801: error("nd_init_ord : unsupported order");
6802: }
1.1 noro 6803: break;
6804: }
6805: nd_ord = ord;
6806: }
6807:
6808: BlockMask nd_create_blockmask(struct order_spec *ord)
6809: {
6810: int n,i,j,s,l;
6811: UINT *t;
6812: BlockMask bm;
6813:
6814: /* we only create mask table for block order */
6815: if ( ord->id != 1 && ord->id != 257 )
6816: return 0;
6817: n = ord->ord.block.length;
6818: bm = (BlockMask)MALLOC(sizeof(struct oBlockMask));
6819: bm->n = n;
6820: bm->order_pair = ord->ord.block.order_pair;
6821: bm->mask = (UINT **)MALLOC(n*sizeof(UINT *));
6822: for ( i = 0, s = 0; i < n; i++ ) {
6823: bm->mask[i] = t = (UINT *)MALLOC_ATOMIC(nd_wpd*sizeof(UINT));
6824: for ( j = 0; j < nd_wpd; j++ ) t[j] = 0;
6825: l = bm->order_pair[i].length;
6826: for ( j = 0; j < l; j++, s++ ) PUT_EXP(t,s,nd_mask0);
6827: }
6828: return bm;
6829: }
6830:
6831: EPOS nd_create_epos(struct order_spec *ord)
6832: {
6833: int i,j,l,s,ord_l,ord_o;
6834: EPOS epos;
6835: struct order_pair *op;
6836:
6837: epos = (EPOS)MALLOC_ATOMIC(nd_nvar*sizeof(struct oEPOS));
6838: switch ( ord->id ) {
1.21 noro 6839: case 0: case 256: case 300:
1.1 noro 6840: if ( nd_isrlex ) {
6841: for ( i = 0; i < nd_nvar; i++ ) {
6842: epos[i].i = nd_exporigin + (nd_nvar-1-i)/nd_epw;
6843: epos[i].s = (nd_epw-((nd_nvar-1-i)%nd_epw)-1)*nd_bpe;
6844: }
6845: } else {
6846: for ( i = 0; i < nd_nvar; i++ ) {
6847: epos[i].i = nd_exporigin + i/nd_epw;
6848: epos[i].s = (nd_epw-(i%nd_epw)-1)*nd_bpe;
6849: }
6850: }
6851: break;
6852: case 1: case 257:
6853: /* block order */
6854: l = ord->ord.block.length;
6855: op = ord->ord.block.order_pair;
6856: for ( j = 0, s = 0; j < l; j++ ) {
6857: ord_o = op[j].order;
6858: ord_l = op[j].length;
6859: if ( !ord_o )
6860: for ( i = 0; i < ord_l; i++ ) {
6861: epos[s+i].i = nd_exporigin + (s+ord_l-i-1)/nd_epw;
6862: epos[s+i].s = (nd_epw-((s+ord_l-i-1)%nd_epw)-1)*nd_bpe;
6863: }
6864: else
6865: for ( i = 0; i < ord_l; i++ ) {
6866: epos[s+i].i = nd_exporigin + (s+i)/nd_epw;
6867: epos[s+i].s = (nd_epw-((s+i)%nd_epw)-1)*nd_bpe;
6868: }
6869: s += ord_l;
6870: }
6871: break;
6872: case 2:
6873: /* matrix order */
6874: case 3:
6875: /* composite order */
6876: default:
6877: for ( i = 0; i < nd_nvar; i++ ) {
6878: epos[i].i = nd_exporigin + i/nd_epw;
6879: epos[i].s = (nd_epw-(i%nd_epw)-1)*nd_bpe;
6880: }
6881: break;
6882: }
6883: return epos;
6884: }
6885:
6886: /* external interface */
6887:
6888: void nd_nf_p(Obj f,LIST g,LIST v,int m,struct order_spec *ord,Obj *rp)
6889: {
6890: NODE t,in0,in;
6891: ND ndf,nf;
6892: NDV ndvf;
6893: VL vv,tv;
6894: int stat,nvar,max,mrank;
6895: union oNDC dn;
6896: Q cont;
6897: P pp;
6898: LIST ppl;
6899:
6900: if ( !f ) {
6901: *rp = 0;
6902: return;
6903: }
6904: pltovl(v,&vv);
6905: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
6906:
6907: /* max=65536 implies nd_bpe=32 */
6908: max = 65536;
6909:
6910: nd_module = 0;
6911: /* nd_module will be set if ord is a module ordering */
6912: nd_init_ord(ord);
6913: nd_setup_parameters(nvar,max);
6914: if ( nd_module && OID(f) != O_LIST )
6915: error("nd_nf_p : the first argument must be a list");
6916: if ( nd_module ) mrank = length(BDY((LIST)f));
6917: /* conversion to ndv */
6918: for ( in0 = 0, t = BDY(g); t; t = NEXT(t) ) {
6919: NEXTNODE(in0,in);
6920: if ( nd_module ) {
6921: if ( !BDY(t) || OID(BDY(t)) != O_LIST
6922: || length(BDY((LIST)BDY(t))) != mrank )
6923: error("nd_nf_p : inconsistent basis element");
6924: if ( !m ) pltozpl((LIST)BDY(t),&cont,&ppl);
6925: else ppl = (LIST)BDY(t);
6926: BDY(in) = (pointer)pltondv(CO,vv,ppl);
6927: } else {
6928: if ( !m ) ptozp((P)BDY(t),1,&cont,&pp);
6929: else pp = (P)BDY(t);
6930: BDY(in) = (pointer)ptondv(CO,vv,pp);
6931: }
6932: if ( m ) ndv_mod(m,(NDV)BDY(in));
6933: }
6934: if ( in0 ) NEXT(in) = 0;
6935:
6936: if ( nd_module ) ndvf = pltondv(CO,vv,(LIST)f);
6937: else ndvf = ptondv(CO,vv,(P)f);
6938: if ( m ) ndv_mod(m,ndvf);
6939: ndf = (pointer)ndvtond(m,ndvf);
6940:
6941: /* dont sort, dont removecont */
1.24 noro 6942: ndv_setup(m,0,in0,1,1,0);
1.1 noro 6943: nd_scale=2;
1.6 noro 6944: stat = nd_nf(m,0,ndf,nd_ps,1,&nf);
1.1 noro 6945: if ( !stat )
6946: error("nd_nf_p : exponent too large");
6947: if ( nd_module ) *rp = (Obj)ndvtopl(m,CO,vv,ndtondv(m,nf),mrank);
6948: else *rp = (Obj)ndvtop(m,CO,vv,ndtondv(m,nf));
6949: }
6950:
6951: int nd_to_vect(int mod,UINT *s0,int n,ND d,UINT *r)
6952: {
6953: NM m;
6954: UINT *t,*s;
6955: int i;
6956:
6957: for ( i = 0; i < n; i++ ) r[i] = 0;
6958: for ( i = 0, s = s0, m = BDY(d); m; m = NEXT(m) ) {
6959: t = DL(m);
6960: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
6961: r[i] = CM(m);
6962: }
6963: for ( i = 0; !r[i]; i++ );
6964: return i;
6965: }
6966:
6967: int nd_to_vect_q(UINT *s0,int n,ND d,Z *r)
6968: {
6969: NM m;
6970: UINT *t,*s;
6971: int i;
6972:
6973: for ( i = 0; i < n; i++ ) r[i] = 0;
6974: for ( i = 0, s = s0, m = BDY(d); m; m = NEXT(m) ) {
6975: t = DL(m);
6976: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
1.6 noro 6977: r[i] = CZ(m);
1.1 noro 6978: }
6979: for ( i = 0; !r[i]; i++ );
6980: return i;
6981: }
6982:
6983: int nd_to_vect_lf(UINT *s0,int n,ND d,mpz_t *r)
6984: {
6985: NM m;
6986: UINT *t,*s;
6987: int i;
6988:
6989: for ( i = 0; i < n; i++ ) { mpz_init(r[i]); mpz_set_ui(r[i],0); }
6990: for ( i = 0, s = s0, m = BDY(d); m; m = NEXT(m) ) {
6991: t = DL(m);
6992: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
6993: mpz_set(r[i],BDY(CZ(m)));
6994: }
6995: for ( i = 0; !mpz_sgn(r[i]); i++ );
6996: return i;
6997: }
6998:
6999: unsigned long *nd_to_vect_2(UINT *s0,int n,int *s0hash,ND p)
7000: {
7001: NM m;
7002: unsigned long *v;
7003: int i,j,h,size;
7004: UINT *s,*t;
7005:
7006: size = sizeof(unsigned long)*(n+BLEN-1)/BLEN;
7007: v = (unsigned long *)MALLOC_ATOMIC_IGNORE_OFF_PAGE(size);
7008: bzero(v,size);
7009: for ( i = j = 0, s = s0, m = BDY(p); m; j++, m = NEXT(m) ) {
7010: t = DL(m);
7011: h = ndl_hash_value(t);
7012: for ( ; h != s0hash[i] || !ndl_equal(t,s); s += nd_wpd, i++ );
7013: v[i/BLEN] |= 1L <<(i%BLEN);
7014: }
7015: return v;
7016: }
7017:
7018: int nd_nm_to_vect_2(UINT *s0,int n,int *s0hash,NDV p,NM m,unsigned long *v)
7019: {
7020: NMV mr;
7021: UINT *d,*t,*s;
7022: int i,j,len,h,head;
7023:
7024: d = DL(m);
7025: len = LEN(p);
7026: t = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
7027: for ( i = j = 0, s = s0, mr = BDY(p); j < len; j++, NMV_ADV(mr) ) {
7028: ndl_add(d,DL(mr),t);
7029: h = ndl_hash_value(t);
7030: for ( ; h != s0hash[i] || !ndl_equal(t,s); s += nd_wpd, i++ );
7031: if ( j == 0 ) head = i;
7032: v[i/BLEN] |= 1L <<(i%BLEN);
7033: }
7034: return head;
7035: }
7036:
7037: Z *nm_ind_pair_to_vect(int mod,UINT *s0,int n,NM_ind_pair pair)
7038: {
7039: NM m;
7040: NMV mr;
7041: UINT *d,*t,*s;
7042: NDV p;
7043: int i,j,len;
7044: Z *r;
7045:
7046: m = pair->mul;
7047: d = DL(m);
7048: p = nd_ps[pair->index];
7049: len = LEN(p);
7050: r = (Z *)CALLOC(n,sizeof(Q));
7051: t = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
7052: for ( i = j = 0, s = s0, mr = BDY(p); j < len; j++, NMV_ADV(mr) ) {
7053: ndl_add(d,DL(mr),t);
7054: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
1.6 noro 7055: r[i] = CZ(mr);
1.1 noro 7056: }
7057: return r;
7058: }
7059:
1.11 noro 7060: IndArray nm_ind_pair_to_vect_compress(int trace,UINT *s0,int n,NM_ind_pair pair,int start)
1.1 noro 7061: {
7062: NM m;
7063: NMV mr;
1.11 noro 7064: UINT *d,*t,*s,*u;
1.1 noro 7065: NDV p;
7066: unsigned char *ivc;
7067: unsigned short *ivs;
7068: UINT *v,*ivi,*s0v;
1.11 noro 7069: int i,j,len,prev,diff,cdiff,h,st,ed,md,c;
1.1 noro 7070: IndArray r;
7071:
7072: m = pair->mul;
7073: d = DL(m);
7074: if ( trace )
7075: p = nd_demand?nd_ps_trace_sym[pair->index]:nd_ps_trace[pair->index];
7076: else
7077: p = nd_demand?nd_ps_sym[pair->index]:nd_ps[pair->index];
7078:
7079: len = LEN(p);
7080: t = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
7081: v = (unsigned int *)MALLOC(len*sizeof(unsigned int));
1.11 noro 7082: for ( prev = start, mr = BDY(p), j = 0; j < len; j++, NMV_ADV(mr) ) {
7083: ndl_add(d,DL(mr),t);
7084: st = prev;
7085: ed = n;
7086: while ( ed > st ) {
7087: md = (st+ed)/2;
7088: u = s0+md*nd_wpd;
7089: c = DL_COMPARE(u,t);
7090: if ( c == 0 ) break;
7091: else if ( c > 0 ) st = md;
7092: else ed = md;
7093: }
7094: prev = v[j] = md;
1.1 noro 7095: }
7096: r = (IndArray)MALLOC(sizeof(struct oIndArray));
7097: r->head = v[0];
7098: diff = 0;
7099: for ( i = 1; i < len; i++ ) {
7100: cdiff = v[i]-v[i-1]; diff = MAX(cdiff,diff);
7101: }
7102: if ( diff < 256 ) {
7103: r->width = 1;
7104: ivc = (unsigned char *)MALLOC_ATOMIC(len*sizeof(unsigned char));
7105: r->index.c = ivc;
7106: for ( i = 1, ivc[0] = 0; i < len; i++ ) ivc[i] = v[i]-v[i-1];
7107: } else if ( diff < 65536 ) {
7108: r->width = 2;
7109: ivs = (unsigned short *)MALLOC_ATOMIC(len*sizeof(unsigned short));
7110: r->index.s = ivs;
7111: for ( i = 1, ivs[0] = 0; i < len; i++ ) ivs[i] = v[i]-v[i-1];
7112: } else {
7113: r->width = 4;
7114: ivi = (unsigned int *)MALLOC_ATOMIC(len*sizeof(unsigned int));
7115: r->index.i = ivi;
7116: for ( i = 1, ivi[0] = 0; i < len; i++ ) ivi[i] = v[i]-v[i-1];
7117: }
7118: return r;
7119: }
7120:
7121: int compress_array(Z *svect,Z *cvect,int n)
7122: {
7123: int i,j;
7124:
7125: for ( i = j = 0; i < n; i++ )
7126: if ( svect[i] ) cvect[j++] = svect[i];
7127: return j;
7128: }
7129:
7130: void expand_array(Z *svect,Z *cvect,int n)
7131: {
7132: int i,j;
7133:
7134: for ( i = j = 0; j < n; i++ )
7135: if ( svect[i] ) svect[i] = cvect[j++];
7136: }
7137:
1.8 noro 7138: #if 0
1.1 noro 7139: int ndv_reduce_vect_q(Z *svect,int trace,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
7140: {
7141: int i,j,k,len,pos,prev,nz;
7142: Z cs,mcs,c1,c2,cr,gcd,t;
7143: IndArray ivect;
7144: unsigned char *ivc;
7145: unsigned short *ivs;
7146: unsigned int *ivi;
7147: NDV redv;
7148: NMV mr;
7149: NODE rp;
7150: int maxrs;
7151: double hmag;
7152: Z *cvect;
1.3 noro 7153: int l;
1.1 noro 7154:
7155: maxrs = 0;
7156: for ( i = 0; i < col && !svect[i]; i++ );
7157: if ( i == col ) return maxrs;
7158: hmag = p_mag((P)svect[i])*nd_scale;
7159: cvect = (Z *)MALLOC(col*sizeof(Q));
7160: for ( i = 0; i < nred; i++ ) {
7161: ivect = imat[i];
7162: k = ivect->head;
7163: if ( svect[k] ) {
7164: maxrs = MAX(maxrs,rp0[i]->sugar);
7165: redv = nd_demand?ndv_load(rp0[i]->index)
7166: :(trace?nd_ps_trace[rp0[i]->index]:nd_ps[rp0[i]->index]);
7167: len = LEN(redv); mr = BDY(redv);
1.6 noro 7168: igcd_cofactor(svect[k],CZ(mr),&gcd,&cs,&cr);
1.1 noro 7169: chsgnz(cs,&mcs);
7170: if ( !UNIQ(cr) ) {
7171: for ( j = 0; j < col; j++ ) {
7172: mulz(svect[j],cr,&c1); svect[j] = c1;
7173: }
7174: }
7175: svect[k] = 0; prev = k;
7176: switch ( ivect->width ) {
7177: case 1:
7178: ivc = ivect->index.c;
7179: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7180: pos = prev+ivc[j]; prev = pos;
1.6 noro 7181: muladdtoz(CZ(mr),mcs,&svect[pos]);
1.1 noro 7182: }
7183: break;
7184: case 2:
7185: ivs = ivect->index.s;
7186: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7187: pos = prev+ivs[j]; prev = pos;
1.6 noro 7188: muladdtoz(CZ(mr),mcs,&svect[pos]);
1.1 noro 7189: }
7190: break;
7191: case 4:
7192: ivi = ivect->index.i;
7193: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7194: pos = prev+ivi[j]; prev = pos;
1.6 noro 7195: muladdtoz(CZ(mr),mcs,&svect[pos]);
1.1 noro 7196: }
7197: break;
7198: }
7199: for ( j = k+1; j < col && !svect[j]; j++ );
7200: if ( j == col ) break;
7201: if ( hmag && ((double)p_mag((P)svect[j]) > hmag) ) {
7202: nz = compress_array(svect,cvect,col);
7203: removecont_array((P *)cvect,nz,1);
7204: expand_array(svect,cvect,nz);
7205: hmag = ((double)p_mag((P)svect[j]))*nd_scale;
7206: }
7207: }
7208: }
7209: nz = compress_array(svect,cvect,col);
7210: removecont_array((P *)cvect,nz,1);
7211: expand_array(svect,cvect,nz);
7212: if ( DP_Print ) {
7213: fprintf(asir_out,"-"); fflush(asir_out);
7214: }
7215: return maxrs;
7216: }
1.4 noro 7217: #else
1.9 noro 7218:
1.4 noro 7219: /* direct mpz version */
7220: int ndv_reduce_vect_q(Z *svect0,int trace,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
7221: {
7222: int i,j,k,len,pos,prev;
7223: mpz_t cs,cr,gcd;
7224: IndArray ivect;
7225: unsigned char *ivc;
7226: unsigned short *ivs;
7227: unsigned int *ivi;
7228: NDV redv;
7229: NMV mr;
7230: NODE rp;
7231: int maxrs;
7232: double hmag;
7233: int l;
1.13 noro 7234: static mpz_t *svect;
7235: static int svect_len=0;
1.4 noro 7236:
7237: maxrs = 0;
7238: for ( i = 0; i < col && !svect0[i]; i++ );
7239: if ( i == col ) return maxrs;
7240: hmag = p_mag((P)svect0[i])*nd_scale;
1.13 noro 7241: if ( col > svect_len ) {
7242: svect = (mpz_t *)MALLOC(col*sizeof(mpz_t));
7243: svect_len = col;
7244: }
1.4 noro 7245: for ( i = 0; i < col; i++ ) {
7246: mpz_init(svect[i]);
7247: if ( svect0[i] )
7248: mpz_set(svect[i],BDY(svect0[i]));
7249: else
7250: mpz_set_ui(svect[i],0);
7251: }
7252: mpz_init(gcd); mpz_init(cs); mpz_init(cr);
7253: for ( i = 0; i < nred; i++ ) {
7254: ivect = imat[i];
7255: k = ivect->head;
7256: if ( mpz_sgn(svect[k]) ) {
7257: maxrs = MAX(maxrs,rp0[i]->sugar);
7258: redv = nd_demand?ndv_load(rp0[i]->index)
7259: :(trace?nd_ps_trace[rp0[i]->index]:nd_ps[rp0[i]->index]);
7260: len = LEN(redv); mr = BDY(redv);
1.6 noro 7261: mpz_gcd(gcd,svect[k],BDY(CZ(mr)));
1.4 noro 7262: mpz_div(cs,svect[k],gcd);
1.6 noro 7263: mpz_div(cr,BDY(CZ(mr)),gcd);
1.4 noro 7264: mpz_neg(cs,cs);
1.9 noro 7265: if ( MUNIMPZ(cr) )
7266: for ( j = 0; j < col; j++ ) mpz_neg(svect[j],svect[j]);
7267: else if ( !UNIMPZ(cr) )
7268: for ( j = 0; j < col; j++ ) {
7269: if ( mpz_sgn(svect[j]) ) mpz_mul(svect[j],svect[j],cr);
7270: }
1.4 noro 7271: mpz_set_ui(svect[k],0);
7272: prev = k;
7273: switch ( ivect->width ) {
7274: case 1:
7275: ivc = ivect->index.c;
7276: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7277: pos = prev+ivc[j]; prev = pos;
1.6 noro 7278: mpz_addmul(svect[pos],BDY(CZ(mr)),cs);
1.4 noro 7279: }
7280: break;
7281: case 2:
7282: ivs = ivect->index.s;
7283: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7284: pos = prev+ivs[j]; prev = pos;
1.6 noro 7285: mpz_addmul(svect[pos],BDY(CZ(mr)),cs);
1.4 noro 7286: }
7287: break;
7288: case 4:
7289: ivi = ivect->index.i;
7290: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7291: pos = prev+ivi[j]; prev = pos;
1.6 noro 7292: mpz_addmul(svect[pos],BDY(CZ(mr)),cs);
1.4 noro 7293: }
7294: break;
7295: }
7296: for ( j = k+1; j < col && !svect[j]; j++ );
7297: if ( j == col ) break;
7298: if ( hmag && ((double)mpz_sizeinbase(svect[j],2) > hmag) ) {
7299: mpz_removecont_array(svect,col);
7300: hmag = ((double)mpz_sizeinbase(svect[j],2))*nd_scale;
7301: }
7302: }
7303: }
7304: mpz_removecont_array(svect,col);
7305: if ( DP_Print ) {
7306: fprintf(asir_out,"-"); fflush(asir_out);
7307: }
7308: for ( i = 0; i < col; i++ )
7309: if ( mpz_sgn(svect[i]) ) MPZTOZ(svect[i],svect0[i]);
7310: else svect0[i] = 0;
7311: return maxrs;
7312: }
7313: #endif
1.1 noro 7314:
7315: int ndv_reduce_vect(int m,UINT *svect,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
7316: {
7317: int i,j,k,len,pos,prev;
7318: UINT c,c1,c2,c3,up,lo,dmy;
7319: IndArray ivect;
7320: unsigned char *ivc;
7321: unsigned short *ivs;
7322: unsigned int *ivi;
7323: NDV redv;
7324: NMV mr;
7325: NODE rp;
7326: int maxrs;
7327:
7328: maxrs = 0;
7329: for ( i = 0; i < nred; i++ ) {
7330: ivect = imat[i];
7331: k = ivect->head; svect[k] %= m;
7332: if ( (c = svect[k]) != 0 ) {
7333: maxrs = MAX(maxrs,rp0[i]->sugar);
7334: c = m-c; redv = nd_ps[rp0[i]->index];
7335: len = LEN(redv); mr = BDY(redv);
7336: svect[k] = 0; prev = k;
7337: switch ( ivect->width ) {
7338: case 1:
7339: ivc = ivect->index.c;
7340: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7341: pos = prev+ivc[j]; c1 = CM(mr); prev = pos;
7342: if ( c1 ) {
7343: c2 = svect[pos];
7344: DMA(c1,c,c2,up,lo);
7345: if ( up ) { DSAB(m,up,lo,dmy,c3); svect[pos] = c3;
7346: } else svect[pos] = lo;
7347: }
7348: }
7349: break;
7350: case 2:
7351: ivs = ivect->index.s;
7352: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7353: pos = prev+ivs[j]; c1 = CM(mr);
7354: prev = pos;
7355: if ( c1 ) {
7356: c2 = svect[pos];
7357: DMA(c1,c,c2,up,lo);
7358: if ( up ) { DSAB(m,up,lo,dmy,c3); svect[pos] = c3;
7359: } else svect[pos] = lo;
7360: }
7361: }
7362: break;
7363: case 4:
7364: ivi = ivect->index.i;
7365: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7366: pos = prev+ivi[j]; c1 = CM(mr);
7367: prev = pos;
7368: if ( c1 ) {
7369: c2 = svect[pos];
7370: DMA(c1,c,c2,up,lo);
7371: if ( up ) { DSAB(m,up,lo,dmy,c3); svect[pos] = c3;
7372: } else svect[pos] = lo;
7373: }
7374: }
7375: break;
7376: }
7377: }
7378: }
7379: for ( i = 0; i < col; i++ )
7380: if ( svect[i] >= (UINT)m ) svect[i] %= m;
7381: return maxrs;
7382: }
7383:
7384: int ndv_reduce_vect_sf(int m,UINT *svect,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
7385: {
7386: int i,j,k,len,pos,prev;
7387: UINT c,c1,c2,c3,up,lo,dmy;
7388: IndArray ivect;
7389: unsigned char *ivc;
7390: unsigned short *ivs;
7391: unsigned int *ivi;
7392: NDV redv;
7393: NMV mr;
7394: NODE rp;
7395: int maxrs;
7396:
7397: maxrs = 0;
7398: for ( i = 0; i < nred; i++ ) {
7399: ivect = imat[i];
7400: k = ivect->head;
7401: if ( (c = svect[k]) != 0 ) {
7402: maxrs = MAX(maxrs,rp0[i]->sugar);
7403: c = _chsgnsf(c); redv = nd_ps[rp0[i]->index];
7404: len = LEN(redv); mr = BDY(redv);
7405: svect[k] = 0; prev = k;
7406: switch ( ivect->width ) {
7407: case 1:
7408: ivc = ivect->index.c;
7409: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7410: pos = prev+ivc[j]; prev = pos;
7411: svect[pos] = _addsf(_mulsf(CM(mr),c),svect[pos]);
7412: }
7413: break;
7414: case 2:
7415: ivs = ivect->index.s;
7416: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7417: pos = prev+ivs[j]; prev = pos;
7418: svect[pos] = _addsf(_mulsf(CM(mr),c),svect[pos]);
7419: }
7420: break;
7421: case 4:
7422: ivi = ivect->index.i;
7423: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7424: pos = prev+ivi[j]; prev = pos;
7425: svect[pos] = _addsf(_mulsf(CM(mr),c),svect[pos]);
7426: }
7427: break;
7428: }
7429: }
7430: }
7431: return maxrs;
7432: }
7433:
7434: ND nd_add_lf(ND p1,ND p2)
7435: {
7436: int n,c,can;
7437: ND r;
7438: NM m1,m2,mr0,mr,s;
7439: Z t;
7440:
7441: if ( !p1 ) return p2;
7442: else if ( !p2 ) return p1;
7443: else {
7444: can = 0;
7445: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
7446: c = DL_COMPARE(DL(m1),DL(m2));
7447: switch ( c ) {
7448: case 0:
7449: addlf(CZ(m1),CZ(m2),&t);
7450: s = m1; m1 = NEXT(m1);
7451: if ( t ) {
7452: can++; NEXTNM2(mr0,mr,s); CZ(mr) = (t);
7453: } else {
7454: can += 2; FREENM(s);
7455: }
7456: s = m2; m2 = NEXT(m2); FREENM(s);
7457: break;
7458: case 1:
7459: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
7460: break;
7461: case -1:
7462: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
7463: break;
7464: }
7465: }
7466: if ( !mr0 )
7467: if ( m1 ) mr0 = m1;
7468: else if ( m2 ) mr0 = m2;
7469: else return 0;
7470: else if ( m1 ) NEXT(mr) = m1;
7471: else if ( m2 ) NEXT(mr) = m2;
7472: else NEXT(mr) = 0;
7473: BDY(p1) = mr0;
7474: SG(p1) = MAX(SG(p1),SG(p2));
7475: LEN(p1) = LEN(p1)+LEN(p2)-can;
7476: FREEND(p2);
7477: return p1;
7478: }
7479: }
7480:
7481: int ndv_reduce_vect_lf(mpz_t *svect,int trace,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
7482: {
7483: int i,j,k,len,pos,prev;
7484: mpz_t c,mc,c1;
7485: IndArray ivect;
7486: unsigned char *ivc;
7487: unsigned short *ivs;
7488: unsigned int *ivi;
7489: NDV redv;
7490: NMV mr;
7491: NODE rp;
7492: int maxrs;
7493:
7494: maxrs = 0;
7495: lf_lazy = 1;
7496: for ( i = 0; i < nred; i++ ) {
7497: ivect = imat[i];
7498: k = ivect->head;
7499: mpz_mod(svect[k],svect[k],BDY(current_mod_lf));
7500: if ( mpz_sgn(svect[k]) ) {
7501: maxrs = MAX(maxrs,rp0[i]->sugar);
7502: mpz_neg(svect[k],svect[k]);
7503: redv = trace?nd_ps_trace[rp0[i]->index]:nd_ps[rp0[i]->index];
7504: len = LEN(redv); mr = BDY(redv);
7505: prev = k;
7506: switch ( ivect->width ) {
7507: case 1:
7508: ivc = ivect->index.c;
7509: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7510: pos = prev+ivc[j]; prev = pos;
7511: mpz_addmul(svect[pos],svect[k],BDY(CZ(mr)));
7512: }
7513: break;
7514: case 2:
7515: ivs = ivect->index.s;
7516: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7517: pos = prev+ivs[j]; prev = pos;
7518: mpz_addmul(svect[pos],svect[k],BDY(CZ(mr)));
7519: }
7520: break;
7521: case 4:
7522: ivi = ivect->index.i;
7523: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7524: pos = prev+ivi[j]; prev = pos;
7525: mpz_addmul(svect[pos],svect[k],BDY(CZ(mr)));
7526: }
7527: break;
7528: }
7529: mpz_set_ui(svect[k],0);
7530: }
7531: }
7532: lf_lazy=0;
7533: for ( i = 0; i < col; i++ ) {
7534: mpz_mod(svect[i],svect[i],BDY(current_mod_lf));
7535: }
7536: return maxrs;
7537: }
7538:
7539: int nd_gauss_elim_lf(mpz_t **mat0,int *sugar,int row,int col,int *colstat)
7540: {
7541: int i,j,k,l,rank,s;
7542: mpz_t a,a1,inv;
7543: mpz_t *t,*pivot,*pk;
7544: mpz_t **mat;
7545: struct oEGT eg0,eg1,eg_forward,eg_mod,eg_back;
7546: int size,size1;
7547:
7548: mpz_init(inv);
7549: mpz_init(a);
7550: mat = (mpz_t **)mat0;
7551: size = 0;
7552: for ( rank = 0, j = 0; j < col; j++ ) {
7553: for ( i = rank; i < row; i++ ) {
7554: mpz_mod(mat[i][j],mat[i][j],BDY(current_mod_lf));
7555: }
7556: for ( i = rank; i < row; i++ )
7557: if ( mpz_sgn(mat[i][j]) )
7558: break;
7559: if ( i == row ) {
7560: colstat[j] = 0;
7561: continue;
7562: } else
7563: colstat[j] = 1;
7564: if ( i != rank ) {
7565: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
7566: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
7567: }
7568: pivot = mat[rank];
7569: s = sugar[rank];
7570: mpz_invert(inv,pivot[j],BDY(current_mod_lf));
7571: for ( k = j, pk = pivot+k; k < col; k++, pk++ )
7572: if ( mpz_sgn(*pk) ) {
7573: mpz_mul(a,*pk,inv); mpz_mod(*pk,a,BDY(current_mod_lf));
7574: }
7575: for ( i = rank+1; i < row; i++ ) {
7576: t = mat[i];
7577: if ( mpz_sgn(t[j]) ) {
7578: sugar[i] = MAX(sugar[i],s);
7579: mpz_neg(a,t[j]);
7580: red_by_vect_lf(t+j,pivot+j,a,col-j);
7581: }
7582: }
7583: rank++;
7584: }
7585: for ( j = col-1, l = rank-1; j >= 0; j-- )
7586: if ( colstat[j] ) {
7587: pivot = mat[l];
7588: s = sugar[l];
7589: for ( k = j; k < col; k++ )
7590: mpz_mod(pivot[k],pivot[k],BDY(current_mod_lf));
7591: for ( i = 0; i < l; i++ ) {
7592: t = mat[i];
7593: if ( mpz_sgn(t[j]) ) {
7594: sugar[i] = MAX(sugar[i],s);
7595: mpz_neg(a,t[j]);
7596: red_by_vect_lf(t+j,pivot+j,a,col-j);
7597: }
7598: }
7599: l--;
7600: }
7601: for ( j = 0, l = 0; l < rank; j++ )
7602: if ( colstat[j] ) {
7603: t = mat[l];
7604: for ( k = j; k < col; k++ ) {
7605: mpz_mod(t[k],t[k],BDY(current_mod_lf));
7606: }
7607: l++;
7608: }
7609: return rank;
7610: }
7611:
7612:
7613: NDV vect_to_ndv(UINT *vect,int spcol,int col,int *rhead,UINT *s0vect)
7614: {
7615: int j,k,len;
7616: UINT *p;
7617: UINT c;
7618: NDV r;
7619: NMV mr0,mr;
7620:
7621: for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++;
7622: if ( !len ) return 0;
7623: else {
7624: mr0 = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
7625: #if 0
7626: ndv_alloc += nmv_adv*len;
7627: #endif
7628: mr = mr0;
7629: p = s0vect;
7630: for ( j = k = 0; j < col; j++, p += nd_wpd )
7631: if ( !rhead[j] ) {
7632: if ( (c = vect[k++]) != 0 ) {
7633: ndl_copy(p,DL(mr)); CM(mr) = c; NMV_ADV(mr);
7634: }
7635: }
7636: MKNDV(nd_nvar,mr0,len,r);
7637: return r;
7638: }
7639: }
7640:
7641: NDV vect_to_ndv_2(unsigned long *vect,int col,UINT *s0vect)
7642: {
7643: int j,k,len;
7644: UINT *p;
7645: NDV r;
7646: NMV mr0,mr;
7647:
7648: for ( j = 0, len = 0; j < col; j++ ) if ( vect[j/BLEN] & (1L<<(j%BLEN)) ) len++;
7649: if ( !len ) return 0;
7650: else {
7651: mr0 = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
7652: mr = mr0;
7653: p = s0vect;
7654: for ( j = 0; j < col; j++, p += nd_wpd )
7655: if ( vect[j/BLEN] & (1L<<(j%BLEN)) ) {
7656: ndl_copy(p,DL(mr)); CM(mr) = 1; NMV_ADV(mr);
7657: }
7658: MKNDV(nd_nvar,mr0,len,r);
7659: return r;
7660: }
7661: }
7662:
7663: /* for preprocessed vector */
7664:
7665: NDV vect_to_ndv_q(Z *vect,int spcol,int col,int *rhead,UINT *s0vect)
7666: {
1.6 noro 7667: int j,k,len;
7668: UINT *p;
7669: Z c;
7670: NDV r;
7671: NMV mr0,mr;
1.1 noro 7672:
1.6 noro 7673: for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++;
7674: if ( !len ) return 0;
7675: else {
7676: mr0 = (NMV)MALLOC(nmv_adv*len);
1.1 noro 7677: #if 0
1.6 noro 7678: ndv_alloc += nmv_adv*len;
1.1 noro 7679: #endif
1.6 noro 7680: mr = mr0;
7681: p = s0vect;
7682: for ( j = k = 0; j < col; j++, p += nd_wpd ) {
7683: if ( !rhead[j] ) {
7684: if ( (c = vect[k++]) != 0 ) {
7685: if ( !INT(c) )
7686: error("vect_to_ndv_q : components must be integers");
7687: ndl_copy(p,DL(mr)); CZ(mr) = c; NMV_ADV(mr);
7688: }
7689: }
1.1 noro 7690: }
1.6 noro 7691: MKNDV(nd_nvar,mr0,len,r);
7692: return r;
7693: }
1.1 noro 7694: }
7695:
7696: NDV vect_to_ndv_lf(mpz_t *vect,int spcol,int col,int *rhead,UINT *s0vect)
7697: {
7698: int j,k,len;
7699: UINT *p;
7700: mpz_t c;
7701: NDV r;
7702: NMV mr0,mr;
7703:
7704: for ( j = 0, len = 0; j < spcol; j++ ) if ( mpz_sgn(vect[j]) ) len++;
7705: if ( !len ) return 0;
7706: else {
7707: mr0 = (NMV)MALLOC(nmv_adv*len);
7708: #if 0
7709: ndv_alloc += nmv_adv*len;
7710: #endif
7711: mr = mr0;
7712: p = s0vect;
7713: for ( j = k = 0; j < col; j++, p += nd_wpd )
7714: if ( !rhead[j] ) {
7715: c[0] = vect[k++][0];
7716: if ( mpz_sgn(c) ) {
7717: ndl_copy(p,DL(mr)); MPZTOZ(c,CZ(mr)); NMV_ADV(mr);
7718: }
7719: }
7720: MKNDV(nd_nvar,mr0,len,r);
7721: return r;
7722: }
7723: }
7724:
7725: /* for plain vector */
7726:
7727: NDV plain_vect_to_ndv_q(Z *vect,int col,UINT *s0vect)
7728: {
7729: int j,k,len;
7730: UINT *p;
7731: Z c;
7732: NDV r;
7733: NMV mr0,mr;
7734:
7735: for ( j = 0, len = 0; j < col; j++ ) if ( vect[j] ) len++;
7736: if ( !len ) return 0;
7737: else {
7738: mr0 = (NMV)MALLOC(nmv_adv*len);
7739: #if 0
7740: ndv_alloc += nmv_adv*len;
7741: #endif
7742: mr = mr0;
7743: p = s0vect;
7744: for ( j = k = 0; j < col; j++, p += nd_wpd, k++ )
7745: if ( (c = vect[k]) != 0 ) {
7746: if ( !INT(c) )
1.6 noro 7747: error("plain_vect_to_ndv_q : components must be integers");
7748: ndl_copy(p,DL(mr)); CZ(mr) = c; NMV_ADV(mr);
1.1 noro 7749: }
7750: MKNDV(nd_nvar,mr0,len,r);
7751: return r;
7752: }
7753: }
7754:
7755: int nd_sp_f4(int m,int trace,ND_pairs l,PGeoBucket bucket)
7756: {
7757: ND_pairs t;
7758: NODE sp0,sp;
7759: int stat;
7760: ND spol;
7761:
7762: for ( t = l; t; t = NEXT(t) ) {
7763: stat = nd_sp(m,trace,t,&spol);
7764: if ( !stat ) return 0;
7765: if ( spol ) {
7766: add_pbucket_symbolic(bucket,spol);
7767: }
7768: }
7769: return 1;
7770: }
7771:
7772: int nd_symbolic_preproc(PGeoBucket bucket,int trace,UINT **s0vect,NODE *r)
7773: {
7774: NODE rp0,rp;
7775: NM mul,head,s0,s;
7776: int index,col,i,sugar;
7777: RHist h;
7778: UINT *s0v,*p;
7779: NM_ind_pair pair;
7780: ND red;
7781: NDV *ps;
7782:
7783: s0 = 0; rp0 = 0; col = 0;
7784: if ( nd_demand )
7785: ps = trace?nd_ps_trace_sym:nd_ps_sym;
7786: else
7787: ps = trace?nd_ps_trace:nd_ps;
7788: while ( 1 ) {
7789: head = remove_head_pbucket_symbolic(bucket);
7790: if ( !head ) break;
7791: if ( !s0 ) s0 = head;
7792: else NEXT(s) = head;
7793: s = head;
7794: index = ndl_find_reducer(DL(head));
7795: if ( index >= 0 ) {
7796: h = nd_psh[index];
7797: NEWNM(mul);
7798: ndl_sub(DL(head),DL(h),DL(mul));
7799: if ( ndl_check_bound2(index,DL(mul)) )
7800: return 0;
7801: sugar = TD(DL(mul))+SG(ps[index]);
1.28 noro 7802: MKNM_ind_pair(pair,mul,index,sugar,0);
1.1 noro 7803: red = ndv_mul_nm_symbolic(mul,ps[index]);
7804: add_pbucket_symbolic(bucket,nd_remove_head(red));
7805: NEXTNODE(rp0,rp); BDY(rp) = (pointer)pair;
7806: }
7807: col++;
7808: }
7809: if ( rp0 ) NEXT(rp) = 0;
7810: NEXT(s) = 0;
7811: s0v = (UINT *)MALLOC_ATOMIC(col*nd_wpd*sizeof(UINT));
7812: for ( i = 0, p = s0v, s = s0; i < col;
7813: i++, p += nd_wpd, s = NEXT(s) ) ndl_copy(DL(s),p);
7814: *s0vect = s0v;
7815: *r = rp0;
7816: return col;
7817: }
7818:
7819: void print_ndp(ND_pairs l)
7820: {
7821: ND_pairs t;
7822:
7823: for ( t = l; t; t = NEXT(t) )
7824: printf("[%d,%d] ",t->i1,t->i2);
7825: printf("\n");
7826: }
7827:
7828: NODE nd_f4(int m,int checkonly,int **indp)
7829: {
7830: int i,nh,stat,index,f4red;
7831: NODE r,g,tn0,tn,node;
7832: ND_pairs d,l,t,ll0,ll,lh;
7833: LIST l0,l1;
7834: ND spol,red;
7835: NDV nf,redv;
7836: NM s0,s;
7837: NODE rp0,srp0,nflist,nzlist,nzlist_t;
7838: int nsp,nred,col,rank,len,k,j,a,i1s,i2s;
7839: UINT c;
7840: UINT **spmat;
7841: UINT *s0vect,*svect,*p,*v;
7842: int *colstat;
7843: IndArray *imat;
7844: int *rhead;
7845: int spcol,sprow;
7846: int sugar,sugarh;
7847: PGeoBucket bucket;
7848: struct oEGT eg0,eg1,eg_f4;
7849: Z i1,i2,sugarq;
1.12 noro 7850:
7851: init_eg(&f4_symb); init_eg(&f4_conv); init_eg(&f4_conv); init_eg(&f4_elim1); init_eg(&f4_elim2);
1.1 noro 7852: #if 0
7853: ndv_alloc = 0;
7854: #endif
1.11 noro 7855: Nf4_red=0;
1.1 noro 7856: g = 0; d = 0;
7857: for ( i = 0; i < nd_psn; i++ ) {
7858: d = update_pairs(d,g,i,0);
7859: g = update_base(g,i);
7860: }
7861: nzlist = 0;
7862: nzlist_t = nd_nzlist;
7863: f4red = 1;
7864: nd_last_nonzero = 0;
7865: while ( d ) {
7866: get_eg(&eg0);
7867: l = nd_minsugarp(d,&d);
7868: sugar = nd_sugarweight?l->sugar2:SG(l);
7869: if ( MaxDeg > 0 && sugar > MaxDeg ) break;
7870: if ( nzlist_t ) {
7871: node = BDY((LIST)BDY(nzlist_t));
1.6 noro 7872: sugarh = ZTOS((Q)ARG0(node));
1.1 noro 7873: tn = BDY((LIST)ARG1(node));
7874: if ( !tn ) {
7875: nzlist_t = NEXT(nzlist_t);
7876: continue;
7877: }
7878: /* tn = [[i1,i2],...] */
7879: lh = nd_ipairtospair(tn);
7880: }
7881: bucket = create_pbucket();
7882: stat = nd_sp_f4(m,0,l,bucket);
7883: if ( !stat ) {
7884: for ( t = l; NEXT(t); t = NEXT(t) );
7885: NEXT(t) = d; d = l;
7886: d = nd_reconstruct(0,d);
7887: continue;
7888: }
7889: if ( bucket->m < 0 ) continue;
7890: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
7891: if ( !col ) {
7892: for ( t = l; NEXT(t); t = NEXT(t) );
7893: NEXT(t) = d; d = l;
7894: d = nd_reconstruct(0,d);
7895: continue;
7896: }
1.12 noro 7897: get_eg(&eg1); init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg1); add_eg(&f4_symb,&eg0,&eg1);
1.1 noro 7898: if ( DP_Print )
1.6 noro 7899: fprintf(asir_out,"sugar=%d,symb=%.3fsec,",
1.5 noro 7900: sugar,eg_f4.exectime);
1.1 noro 7901: nflist = nd_f4_red(m,nd_nzlist?lh:l,0,s0vect,col,rp0,nd_gentrace?&ll:0);
7902: if ( checkonly && nflist ) return 0;
7903: /* adding new bases */
7904: if ( nflist ) nd_last_nonzero = f4red;
7905: for ( r = nflist; r; r = NEXT(r) ) {
7906: nf = (NDV)BDY(r);
7907: ndv_removecont(m,nf);
7908: if ( !m && nd_nalg ) {
7909: ND nf1;
7910:
7911: nf1 = ndvtond(m,nf);
7912: nd_monic(0,&nf1);
7913: nd_removecont(m,nf1);
7914: nf = ndtondv(m,nf1);
7915: }
1.24 noro 7916: nh = ndv_newps(m,nf,0);
1.1 noro 7917: d = update_pairs(d,g,nh,0);
7918: g = update_base(g,nh);
7919: }
7920: if ( DP_Print ) {
7921: fprintf(asir_out,"f4red=%d,gblen=%d\n",f4red,length(g)); fflush(asir_out);
7922: }
7923: if ( nd_gentrace ) {
7924: for ( t = ll, tn0 = 0; t; t = NEXT(t) ) {
7925: NEXTNODE(tn0,tn);
1.6 noro 7926: STOZ(t->i1,i1); STOZ(t->i2,i2);
1.1 noro 7927: node = mknode(2,i1,i2); MKLIST(l0,node);
7928: BDY(tn) = l0;
7929: }
7930: if ( tn0 ) NEXT(tn) = 0; MKLIST(l0,tn0);
1.6 noro 7931: STOZ(sugar,sugarq); node = mknode(2,sugarq,l0); MKLIST(l1,node);
1.1 noro 7932: MKNODE(node,l1,nzlist); nzlist = node;
7933: }
7934: if ( nd_nzlist ) nzlist_t = NEXT(nzlist_t);
7935: f4red++;
7936: if ( nd_f4red && f4red > nd_f4red ) break;
7937: if ( nd_rank0 && !nflist ) break;
7938: }
7939: if ( nd_gentrace ) {
7940: MKLIST(l0,reverse_node(nzlist));
7941: MKNODE(nd_alltracelist,l0,0);
7942: }
7943: #if 0
7944: fprintf(asir_out,"ndv_alloc=%d\n",ndv_alloc);
7945: #endif
1.12 noro 7946: if ( DP_Print ) {
7947: fprintf(asir_out,"number of red=%d,",Nf4_red);
7948: fprintf(asir_out,"symb=%.3fsec,conv=%.3fsec,elim1=%.3fsec,elim2=%.3fsec\n",
7949: f4_symb.exectime,f4_conv.exectime,f4_elim1.exectime,f4_elim2.exectime);
7950: }
1.1 noro 7951: conv_ilist(nd_demand,0,g,indp);
7952: return g;
7953: }
7954:
7955: NODE nd_f4_trace(int m,int **indp)
7956: {
7957: int i,nh,stat,index;
7958: NODE r,g;
7959: ND_pairs d,l,l0,t;
7960: ND spol,red;
7961: NDV nf,redv,nfqv,nfv;
7962: NM s0,s;
7963: NODE rp0,srp0,nflist;
7964: int nsp,nred,col,rank,len,k,j,a;
7965: UINT c;
7966: UINT **spmat;
7967: UINT *s0vect,*svect,*p,*v;
7968: int *colstat;
7969: IndArray *imat;
7970: int *rhead;
7971: int spcol,sprow;
7972: int sugar;
7973: PGeoBucket bucket;
7974: struct oEGT eg0,eg1,eg_f4;
7975:
7976: g = 0; d = 0;
7977: for ( i = 0; i < nd_psn; i++ ) {
7978: d = update_pairs(d,g,i,0);
7979: g = update_base(g,i);
7980: }
7981: while ( d ) {
7982: get_eg(&eg0);
7983: l = nd_minsugarp(d,&d);
7984: sugar = SG(l);
7985: if ( MaxDeg > 0 && sugar > MaxDeg ) break;
7986: bucket = create_pbucket();
7987: stat = nd_sp_f4(m,0,l,bucket);
7988: if ( !stat ) {
7989: for ( t = l; NEXT(t); t = NEXT(t) );
7990: NEXT(t) = d; d = l;
7991: d = nd_reconstruct(1,d);
7992: continue;
7993: }
7994: if ( bucket->m < 0 ) continue;
7995: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
7996: if ( !col ) {
7997: for ( t = l; NEXT(t); t = NEXT(t) );
7998: NEXT(t) = d; d = l;
7999: d = nd_reconstruct(1,d);
8000: continue;
8001: }
8002: get_eg(&eg1); init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg1);
8003: if ( DP_Print )
1.3 noro 8004: fprintf(asir_out,"\nsugar=%d,symb=%.3fsec,",
1.5 noro 8005: sugar,eg_f4.exectime);
1.1 noro 8006: nflist = nd_f4_red(m,l,0,s0vect,col,rp0,&l0);
8007: if ( !l0 ) continue;
8008: l = l0;
8009:
8010: /* over Q */
8011: bucket = create_pbucket();
8012: stat = nd_sp_f4(0,1,l,bucket);
8013: if ( !stat ) {
8014: for ( t = l; NEXT(t); t = NEXT(t) );
8015: NEXT(t) = d; d = l;
8016: d = nd_reconstruct(1,d);
8017: continue;
8018: }
8019: if ( bucket->m < 0 ) continue;
8020: col = nd_symbolic_preproc(bucket,1,&s0vect,&rp0);
8021: if ( !col ) {
8022: for ( t = l; NEXT(t); t = NEXT(t) );
8023: NEXT(t) = d; d = l;
8024: d = nd_reconstruct(1,d);
8025: continue;
8026: }
8027: nflist = nd_f4_red(0,l,1,s0vect,col,rp0,0);
8028: /* adding new bases */
8029: for ( r = nflist; r; r = NEXT(r) ) {
8030: nfqv = (NDV)BDY(r);
8031: ndv_removecont(0,nfqv);
1.6 noro 8032: if ( !remqi((Q)HCZ(nfqv),m) ) return 0;
1.1 noro 8033: if ( nd_nalg ) {
8034: ND nf1;
8035:
8036: nf1 = ndvtond(m,nfqv);
8037: nd_monic(0,&nf1);
8038: nd_removecont(0,nf1);
8039: nfqv = ndtondv(0,nf1); nd_free(nf1);
8040: }
8041: nfv = ndv_dup(0,nfqv);
8042: ndv_mod(m,nfv);
8043: ndv_removecont(m,nfv);
1.24 noro 8044: nh = ndv_newps(0,nfv,nfqv);
1.1 noro 8045: d = update_pairs(d,g,nh,0);
8046: g = update_base(g,nh);
8047: }
8048: }
8049: #if 0
8050: fprintf(asir_out,"ndv_alloc=%d\n",ndv_alloc);
8051: #endif
8052: conv_ilist(nd_demand,1,g,indp);
8053: return g;
8054: }
8055:
8056: int rref(matrix mat,int *sugar)
8057: {
8058: int row,col,i,j,k,l,s,wcol,wj;
8059: unsigned long bj;
8060: unsigned long **a;
8061: unsigned long *ai,*ak,*as,*t;
8062: int *pivot;
8063:
8064: row = mat->row;
8065: col = mat->col;
8066: a = mat->a;
8067: wcol = (col+BLEN-1)/BLEN;
8068: pivot = (int *)MALLOC_ATOMIC(row*sizeof(int));
8069: i = 0;
8070: for ( j = 0; j < col; j++ ) {
8071: wj = j/BLEN; bj = 1L<<(j%BLEN);
8072: for ( k = i; k < row; k++ )
8073: if ( a[k][wj] & bj ) break;
8074: if ( k == row ) continue;
8075: pivot[i] = j;
8076: if ( k != i ) {
8077: t = a[i]; a[i] = a[k]; a[k] = t;
8078: s = sugar[i]; sugar[i] = sugar[k]; sugar[k] = s;
8079: }
8080: ai = a[i];
8081: for ( k = i+1; k < row; k++ ) {
8082: ak = a[k];
8083: if ( ak[wj] & bj ) {
8084: for ( l = wj; l < wcol; l++ )
8085: ak[l] ^= ai[l];
8086: sugar[k] = MAX(sugar[k],sugar[i]);
8087: }
8088: }
8089: i++;
8090: }
8091: for ( k = i-1; k >= 0; k-- ) {
8092: j = pivot[k]; wj = j/BLEN; bj = 1L<<(j%BLEN);
8093: ak = a[k];
8094: for ( s = 0; s < k; s++ ) {
8095: as = a[s];
8096: if ( as[wj] & bj ) {
8097: for ( l = wj; l < wcol; l++ )
8098: as[l] ^= ak[l];
8099: sugar[s] = MAX(sugar[s],sugar[k]);
8100: }
8101: }
8102: }
8103: return i;
8104: }
8105:
8106: void print_matrix(matrix mat)
8107: {
8108: int row,col,i,j;
8109: unsigned long *ai;
8110:
8111: row = mat->row;
8112: col = mat->col;
8113: printf("%d x %d\n",row,col);
8114: for ( i = 0; i < row; i++ ) {
8115: ai = mat->a[i];
8116: for ( j = 0; j < col; j++ ) {
8117: if ( ai[j/BLEN] & (1L<<(j%BLEN)) ) putchar('1');
8118: else putchar('0');
8119: }
8120: putchar('\n');
8121: }
8122: }
8123:
8124: NDV vect_to_ndv_2(unsigned long *vect,int col,UINT *s0vect);
8125:
8126: void red_by_vect_2(matrix mat,int *sugar,unsigned long *v,int rhead,int rsugar)
8127: {
8128: int row,col,wcol,wj,i,j;
8129: unsigned long bj;
8130: unsigned long *ai;
8131: unsigned long **a;
8132: int len;
8133: int *pos;
8134:
8135: row = mat->row;
8136: col = mat->col;
8137: wcol = (col+BLEN-1)/BLEN;
8138: pos = (int *)MALLOC(wcol*sizeof(int));
8139: bzero(pos,wcol*sizeof(int));
8140: for ( i = j = 0; i < wcol; i++ )
8141: if ( v[i] ) pos[j++] = i;;
8142: len = j;
8143: wj = rhead/BLEN;
8144: bj = 1L<<rhead%BLEN;
8145: a = mat->a;
8146: for ( i = 0; i < row; i++ ) {
8147: ai = a[i];
8148: if ( ai[wj]&bj ) {
8149: for ( j = 0; j < len; j++ )
8150: ai[pos[j]] ^= v[pos[j]];
8151: sugar[i] = MAX(sugar[i],rsugar);
8152: }
8153: }
8154: }
8155:
8156: NODE nd_f4_red_2(ND_pairs sp0,UINT *s0vect,int col,NODE rp0,ND_pairs *nz)
8157: {
8158: int nsp,nred,i,i0,k,rank,row;
8159: NODE r0,rp;
8160: ND_pairs sp;
8161: ND spol;
8162: NM_ind_pair rt;
8163: int *s0hash;
8164: UINT *s;
8165: int *pivot,*sugar,*head;
8166: matrix mat;
8167: NM m;
8168: NODE r;
8169: struct oEGT eg0,eg1,eg2,eg_elim1,eg_elim2;
8170: int rhead,rsugar,size;
8171: unsigned long *v;
8172:
8173: get_eg(&eg0);
8174: for ( sp = sp0, nsp = 0; sp; sp = NEXT(sp), nsp++ );
8175: nred = length(rp0);
8176: mat = alloc_matrix(nsp,col);
8177: s0hash = (int *)MALLOC(col*sizeof(int));
8178: for ( i = 0, s = s0vect; i < col; i++, s += nd_wpd )
8179: s0hash[i] = ndl_hash_value(s);
8180:
8181: sugar = (int *)MALLOC(nsp*sizeof(int));
8182: for ( i = 0, sp = sp0; sp; sp = NEXT(sp) ) {
8183: nd_sp(2,0,sp,&spol);
8184: if ( spol ) {
8185: mat->a[i] = nd_to_vect_2(s0vect,col,s0hash,spol);
8186: sugar[i] = SG(spol);
8187: i++;
8188: }
8189: }
8190: mat->row = i;
8191: if ( DP_Print ) {
8192: fprintf(asir_out,"%dx%d,",mat->row,mat->col); fflush(asir_out);
8193: }
8194: size = ((col+BLEN-1)/BLEN)*sizeof(unsigned long);
8195: v = CALLOC((col+BLEN-1)/BLEN,sizeof(unsigned long));
8196: for ( rp = rp0, i = 0; rp; rp = NEXT(rp), i++ ) {
8197: rt = (NM_ind_pair)BDY(rp);
8198: bzero(v,size);
8199: rhead = nd_nm_to_vect_2(s0vect,col,s0hash,nd_ps[rt->index],rt->mul,v);
8200: rsugar = SG(nd_ps[rt->index])+TD(DL(rt->mul));
8201: red_by_vect_2(mat,sugar,v,rhead,rsugar);
8202: }
8203:
8204: get_eg(&eg1);
8205: init_eg(&eg_elim1); add_eg(&eg_elim1,&eg0,&eg1);
8206: rank = rref(mat,sugar);
8207:
8208: for ( i = 0, r0 = 0; i < rank; i++ ) {
8209: NEXTNODE(r0,r);
8210: BDY(r) = (pointer)vect_to_ndv_2(mat->a[i],col,s0vect);
8211: SG((NDV)BDY(r)) = sugar[i];
8212: }
8213: if ( r0 ) NEXT(r) = 0;
8214: get_eg(&eg2);
8215: init_eg(&eg_elim2); add_eg(&eg_elim2,&eg1,&eg2);
8216: if ( DP_Print ) {
8217: fprintf(asir_out,"elim1=%.3fsec,elim2=%.3fsec,",
1.5 noro 8218: eg_elim1.exectime,eg_elim2.exectime);
1.1 noro 8219: fflush(asir_out);
8220: }
8221: return r0;
8222: }
8223:
8224:
8225: NODE nd_f4_red(int m,ND_pairs sp0,int trace,UINT *s0vect,int col,NODE rp0,ND_pairs *nz)
8226: {
8227: IndArray *imat;
1.11 noro 8228: int nsp,nred,i,start;
1.1 noro 8229: int *rhead;
8230: NODE r0,rp;
8231: ND_pairs sp;
8232: NM_ind_pair *rvect;
8233: UINT *s;
8234: int *s0hash;
1.11 noro 8235: struct oEGT eg0,eg1,eg_conv;
1.1 noro 8236:
8237: if ( m == 2 && nd_rref2 )
8238: return nd_f4_red_2(sp0,s0vect,col,rp0,nz);
8239:
8240: for ( sp = sp0, nsp = 0; sp; sp = NEXT(sp), nsp++ );
8241: nred = length(rp0);
8242: imat = (IndArray *)MALLOC(nred*sizeof(IndArray));
8243: rhead = (int *)MALLOC(col*sizeof(int));
8244: for ( i = 0; i < col; i++ ) rhead[i] = 0;
8245:
8246: /* construction of index arrays */
1.11 noro 8247: get_eg(&eg0);
1.1 noro 8248: if ( DP_Print ) {
1.11 noro 8249: fprintf(asir_out,"%dx%d,",nsp+nred,col);
8250: fflush(asir_out);
1.1 noro 8251: }
8252: rvect = (NM_ind_pair *)MALLOC(nred*sizeof(NM_ind_pair));
1.11 noro 8253: for ( start = 0, rp = rp0, i = 0; rp; i++, rp = NEXT(rp) ) {
1.1 noro 8254: rvect[i] = (NM_ind_pair)BDY(rp);
1.11 noro 8255: imat[i] = nm_ind_pair_to_vect_compress(trace,s0vect,col,rvect[i],start);
1.1 noro 8256: rhead[imat[i]->head] = 1;
1.11 noro 8257: start = imat[i]->head;
8258: }
1.12 noro 8259: get_eg(&eg1); init_eg(&eg_conv); add_eg(&eg_conv,&eg0,&eg1); add_eg(&f4_conv,&eg0,&eg1);
1.11 noro 8260: if ( DP_Print ) {
8261: fprintf(asir_out,"conv=%.3fsec,",eg_conv.exectime);
8262: fflush(asir_out);
1.1 noro 8263: }
8264: if ( m > 0 )
1.7 noro 8265: #if SIZEOF_LONG==8
1.1 noro 8266: r0 = nd_f4_red_mod64_main(m,sp0,nsp,s0vect,col,rvect,rhead,imat,nred,nz);
8267: #else
8268: r0 = nd_f4_red_main(m,sp0,nsp,s0vect,col,rvect,rhead,imat,nred,nz);
8269: #endif
8270: else if ( m == -1 )
8271: r0 = nd_f4_red_sf_main(m,sp0,nsp,s0vect,col,rvect,rhead,imat,nred,nz);
8272: else if ( m == -2 )
8273: r0 = nd_f4_red_lf_main(m,sp0,nsp,trace,s0vect,col,rvect,rhead,imat,nred);
8274: else
8275: r0 = nd_f4_red_q_main(sp0,nsp,trace,s0vect,col,rvect,rhead,imat,nred);
8276: return r0;
8277: }
8278:
8279: /* for Fp, 2<=p<2^16 */
8280:
8281: NODE nd_f4_red_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
8282: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz)
8283: {
8284: int spcol,sprow,a;
8285: int i,j,k,l,rank;
8286: NODE r0,r;
8287: ND_pairs sp;
8288: ND spol;
8289: UINT **spmat;
8290: UINT *svect,*v;
8291: int *colstat;
8292: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
8293: int maxrs;
8294: int *spsugar;
8295: ND_pairs *spactive;
8296:
8297: spcol = col-nred;
8298: get_eg(&eg0);
8299: /* elimination (1st step) */
8300: spmat = (UINT **)MALLOC(nsp*sizeof(UINT *));
8301: svect = (UINT *)MALLOC(col*sizeof(UINT));
8302: spsugar = (int *)MALLOC(nsp*sizeof(int));
8303: spactive = !nz?0:(ND_pairs *)MALLOC(nsp*sizeof(ND_pairs));
8304: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
8305: nd_sp(m,0,sp,&spol);
8306: if ( !spol ) continue;
8307: nd_to_vect(m,s0vect,col,spol,svect);
8308: if ( m == -1 )
8309: maxrs = ndv_reduce_vect_sf(m,svect,col,imat,rvect,nred);
8310: else
8311: maxrs = ndv_reduce_vect(m,svect,col,imat,rvect,nred);
8312: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
8313: if ( i < col ) {
8314: spmat[sprow] = v = (UINT *)MALLOC_ATOMIC(spcol*sizeof(UINT));
8315: for ( j = k = 0; j < col; j++ )
8316: if ( !rhead[j] ) v[k++] = svect[j];
8317: spsugar[sprow] = MAX(maxrs,SG(spol));
8318: if ( nz )
8319: spactive[sprow] = sp;
8320: sprow++;
8321: }
8322: nd_free(spol);
8323: }
8324: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
8325: if ( DP_Print ) {
1.5 noro 8326: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 8327: fflush(asir_out);
8328: }
8329: /* free index arrays */
8330: for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c);
8331:
8332: /* elimination (2nd step) */
8333: colstat = (int *)MALLOC(spcol*sizeof(int));
8334: if ( m == -1 )
8335: rank = nd_gauss_elim_sf(spmat,spsugar,sprow,spcol,m,colstat);
8336: else
8337: rank = nd_gauss_elim_mod(spmat,spsugar,spactive,sprow,spcol,m,colstat);
8338: r0 = 0;
8339: for ( i = 0; i < rank; i++ ) {
8340: NEXTNODE(r0,r); BDY(r) =
8341: (pointer)vect_to_ndv(spmat[i],spcol,col,rhead,s0vect);
8342: SG((NDV)BDY(r)) = spsugar[i];
8343: GCFREE(spmat[i]);
8344: }
8345: if ( r0 ) NEXT(r) = 0;
8346:
8347: for ( ; i < sprow; i++ ) GCFREE(spmat[i]);
8348: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
8349: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
8350: if ( DP_Print ) {
1.5 noro 8351: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 8352: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
8353: nsp,nred,sprow,spcol,rank);
1.5 noro 8354: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 8355: }
8356: if ( nz ) {
8357: for ( i = 0; i < rank-1; i++ ) NEXT(spactive[i]) = spactive[i+1];
8358: if ( rank > 0 ) {
8359: NEXT(spactive[rank-1]) = 0;
8360: *nz = spactive[0];
8361: } else
8362: *nz = 0;
8363: }
8364: return r0;
8365: }
8366:
8367:
8368: /* for small finite fields */
8369:
8370: NODE nd_f4_red_sf_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
8371: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz)
8372: {
8373: int spcol,sprow,a;
8374: int i,j,k,l,rank;
8375: NODE r0,r;
8376: ND_pairs sp;
8377: ND spol;
8378: UINT **spmat;
8379: UINT *svect,*v;
8380: int *colstat;
8381: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
8382: int maxrs;
8383: int *spsugar;
8384: ND_pairs *spactive;
8385:
8386: spcol = col-nred;
8387: get_eg(&eg0);
8388: /* elimination (1st step) */
8389: spmat = (UINT **)MALLOC(nsp*sizeof(UINT *));
8390: svect = (UINT *)MALLOC(col*sizeof(UINT));
8391: spsugar = (int *)MALLOC(nsp*sizeof(int));
8392: spactive = !nz?0:(ND_pairs *)MALLOC(nsp*sizeof(ND_pairs));
8393: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
8394: nd_sp(m,0,sp,&spol);
8395: if ( !spol ) continue;
8396: nd_to_vect(m,s0vect,col,spol,svect);
8397: maxrs = ndv_reduce_vect_sf(m,svect,col,imat,rvect,nred);
8398: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
8399: if ( i < col ) {
8400: spmat[sprow] = v = (UINT *)MALLOC_ATOMIC(spcol*sizeof(UINT));
8401: for ( j = k = 0; j < col; j++ )
8402: if ( !rhead[j] ) v[k++] = svect[j];
8403: spsugar[sprow] = MAX(maxrs,SG(spol));
8404: if ( nz )
8405: spactive[sprow] = sp;
8406: sprow++;
8407: }
8408: nd_free(spol);
8409: }
8410: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
8411: if ( DP_Print ) {
1.5 noro 8412: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 8413: fflush(asir_out);
8414: }
8415: /* free index arrays */
8416: for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c);
8417:
8418: /* elimination (2nd step) */
8419: colstat = (int *)MALLOC(spcol*sizeof(int));
8420: rank = nd_gauss_elim_sf(spmat,spsugar,sprow,spcol,m,colstat);
8421: r0 = 0;
8422: for ( i = 0; i < rank; i++ ) {
8423: NEXTNODE(r0,r); BDY(r) =
8424: (pointer)vect_to_ndv(spmat[i],spcol,col,rhead,s0vect);
8425: SG((NDV)BDY(r)) = spsugar[i];
8426: GCFREE(spmat[i]);
8427: }
8428: if ( r0 ) NEXT(r) = 0;
8429:
8430: for ( ; i < sprow; i++ ) GCFREE(spmat[i]);
8431: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
8432: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
8433: if ( DP_Print ) {
1.5 noro 8434: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 8435: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
8436: nsp,nred,sprow,spcol,rank);
1.5 noro 8437: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 8438: }
8439: if ( nz ) {
8440: for ( i = 0; i < rank-1; i++ ) NEXT(spactive[i]) = spactive[i+1];
8441: if ( rank > 0 ) {
8442: NEXT(spactive[rank-1]) = 0;
8443: *nz = spactive[0];
8444: } else
8445: *nz = 0;
8446: }
8447: return r0;
8448: }
8449:
8450: NODE nd_f4_red_lf_main(int m,ND_pairs sp0,int nsp,int trace,UINT *s0vect,int col,
8451: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred)
8452: {
8453: int spcol,sprow,a;
8454: int i,j,k,l,rank;
8455: NODE r0,r;
8456: ND_pairs sp;
8457: ND spol;
8458: mpz_t **spmat;
8459: mpz_t *svect,*v;
8460: int *colstat;
8461: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
8462: int maxrs;
8463: int *spsugar;
8464: pointer *w;
8465:
8466: spcol = col-nred;
8467: get_eg(&eg0);
8468: /* elimination (1st step) */
8469: spmat = (mpz_t **)MALLOC(nsp*sizeof(mpz_t *));
8470: svect = (mpz_t *)MALLOC(col*sizeof(mpz_t));
8471: spsugar = (int *)MALLOC(nsp*sizeof(int));
8472: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
8473: nd_sp(m,trace,sp,&spol);
8474: if ( !spol ) continue;
8475: nd_to_vect_lf(s0vect,col,spol,svect);
8476: maxrs = ndv_reduce_vect_lf(svect,trace,col,imat,rvect,nred);
8477: for ( i = 0; i < col; i++ ) if ( mpz_sgn(svect[i]) ) break;
8478: if ( i < col ) {
8479: spmat[sprow] = v = (mpz_t *)MALLOC(spcol*sizeof(mpz_t));
8480: for ( j = k = 0; j < col; j++ )
8481: if ( !rhead[j] ) v[k++][0] = svect[j][0];
8482: spsugar[sprow] = MAX(maxrs,SG(spol));
8483: sprow++;
8484: }
8485: /* nd_free(spol); */
8486: }
8487: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
8488: if ( DP_Print ) {
1.5 noro 8489: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 8490: fflush(asir_out);
8491: }
8492: /* free index arrays */
8493: /* for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c); */
8494:
8495: /* elimination (2nd step) */
8496: colstat = (int *)MALLOC(spcol*sizeof(int));
8497: rank = nd_gauss_elim_lf(spmat,spsugar,sprow,spcol,colstat);
8498: w = (pointer *)MALLOC(rank*sizeof(pointer));
8499: for ( i = 0; i < rank; i++ ) {
8500: #if 0
8501: w[rank-i-1] = (pointer)vect_to_ndv_lf(spmat[i],spcol,col,rhead,s0vect);
8502: SG((NDV)w[rank-i-1]) = spsugar[i];
8503: #else
8504: w[i] = (pointer)vect_to_ndv_lf(spmat[i],spcol,col,rhead,s0vect);
8505: SG((NDV)w[i]) = spsugar[i];
8506: #endif
8507: /* GCFREE(spmat[i]); */
8508:
8509: }
8510: #if 0
8511: qsort(w,rank,sizeof(NDV),
8512: (int (*)(const void *,const void *))ndv_compare);
8513: #endif
8514: r0 = 0;
8515: for ( i = 0; i < rank; i++ ) {
8516: NEXTNODE(r0,r); BDY(r) = w[i];
8517: }
8518: if ( r0 ) NEXT(r) = 0;
8519:
8520: /* for ( ; i < sprow; i++ ) GCFREE(spmat[i]); */
8521: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
8522: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
8523: if ( DP_Print ) {
1.5 noro 8524: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 8525: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
8526: nsp,nred,sprow,spcol,rank);
1.5 noro 8527: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 8528: }
8529: return r0;
8530: }
8531:
8532: NODE nd_f4_red_q_main(ND_pairs sp0,int nsp,int trace,UINT *s0vect,int col,
8533: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred)
8534: {
8535: int spcol,sprow,a;
8536: int i,j,k,l,rank;
8537: NODE r0,r;
8538: ND_pairs sp;
8539: ND spol;
8540: Z **spmat;
8541: Z *svect,*v;
8542: int *colstat;
8543: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
8544: int maxrs;
8545: int *spsugar;
8546: pointer *w;
8547:
8548: spcol = col-nred;
8549: get_eg(&eg0);
8550: /* elimination (1st step) */
8551: spmat = (Z **)MALLOC(nsp*sizeof(Q *));
8552: svect = (Z *)MALLOC(col*sizeof(Q));
8553: spsugar = (int *)MALLOC(nsp*sizeof(int));
8554: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
8555: nd_sp(0,trace,sp,&spol);
8556: if ( !spol ) continue;
8557: nd_to_vect_q(s0vect,col,spol,svect);
8558: maxrs = ndv_reduce_vect_q(svect,trace,col,imat,rvect,nred);
8559: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
8560: if ( i < col ) {
8561: spmat[sprow] = v = (Z *)MALLOC(spcol*sizeof(Q));
8562: for ( j = k = 0; j < col; j++ )
8563: if ( !rhead[j] ) v[k++] = svect[j];
8564: spsugar[sprow] = MAX(maxrs,SG(spol));
8565: sprow++;
8566: }
8567: /* nd_free(spol); */
8568: }
8569: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
8570: if ( DP_Print ) {
1.5 noro 8571: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 8572: fflush(asir_out);
8573: }
8574: /* free index arrays */
8575: /* for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c); */
8576:
8577: /* elimination (2nd step) */
8578: colstat = (int *)MALLOC(spcol*sizeof(int));
8579: rank = nd_gauss_elim_q(spmat,spsugar,sprow,spcol,colstat);
8580: w = (pointer *)MALLOC(rank*sizeof(pointer));
8581: for ( i = 0; i < rank; i++ ) {
8582: #if 0
8583: w[rank-i-1] = (pointer)vect_to_ndv_q(spmat[i],spcol,col,rhead,s0vect);
8584: SG((NDV)w[rank-i-1]) = spsugar[i];
8585: #else
8586: w[i] = (pointer)vect_to_ndv_q(spmat[i],spcol,col,rhead,s0vect);
8587: SG((NDV)w[i]) = spsugar[i];
8588: #endif
8589: /* GCFREE(spmat[i]); */
8590: }
8591: #if 0
8592: qsort(w,rank,sizeof(NDV),
8593: (int (*)(const void *,const void *))ndv_compare);
8594: #endif
8595: r0 = 0;
8596: for ( i = 0; i < rank; i++ ) {
8597: NEXTNODE(r0,r); BDY(r) = w[i];
8598: }
8599: if ( r0 ) NEXT(r) = 0;
8600:
8601: /* for ( ; i < sprow; i++ ) GCFREE(spmat[i]); */
8602: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
8603: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
8604: if ( DP_Print ) {
1.5 noro 8605: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 8606: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
8607: nsp,nred,sprow,spcol,rank);
1.5 noro 8608: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 8609: }
8610: return r0;
8611: }
8612:
8613: FILE *nd_write,*nd_read;
8614:
8615: void nd_send_int(int a) {
8616: write_int(nd_write,(unsigned int *)&a);
8617: }
8618:
8619: void nd_send_intarray(int *p,int len) {
8620: write_intarray(nd_write,(unsigned int *)p,len);
8621: }
8622:
8623: int nd_recv_int() {
8624: int a;
8625:
8626: read_int(nd_read,(unsigned int *)&a);
8627: return a;
8628: }
8629:
8630: void nd_recv_intarray(int *p,int len) {
8631: read_intarray(nd_read,(unsigned int *)p,len);
8632: }
8633:
8634: void nd_send_ndv(NDV p) {
8635: int len,i;
8636: NMV m;
8637:
8638: if ( !p ) nd_send_int(0);
8639: else {
8640: len = LEN(p);
8641: nd_send_int(len);
8642: m = BDY(p);
8643: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
8644: nd_send_int(CM(m));
8645: nd_send_intarray((int *)DL(m),nd_wpd);
8646: }
8647: }
8648: }
8649:
8650: void nd_send_nd(ND p) {
8651: int len,i;
8652: NM m;
8653:
8654: if ( !p ) nd_send_int(0);
8655: else {
8656: len = LEN(p);
8657: nd_send_int(len);
8658: m = BDY(p);
8659: for ( i = 0; i < len; i++, m = NEXT(m) ) {
8660: nd_send_int(CM(m));
8661: nd_send_intarray((int *)DL(m),nd_wpd);
8662: }
8663: }
8664: }
8665:
8666: NDV nd_recv_ndv()
8667: {
8668: int len,i;
8669: NMV m,m0;
8670: NDV r;
8671:
8672: len = nd_recv_int();
8673: if ( !len ) return 0;
8674: else {
8675: m0 = m = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
8676: #if 0
8677: ndv_alloc += len*nmv_adv;
8678: #endif
8679: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
8680: CM(m) = nd_recv_int();
8681: nd_recv_intarray((int *)DL(m),nd_wpd);
8682: }
8683: MKNDV(nd_nvar,m0,len,r);
8684: return r;
8685: }
8686: }
8687:
8688: int nd_gauss_elim_q(Z **mat0,int *sugar,int row,int col,int *colstat)
8689: {
8690: int i,j,t,c,rank,inv;
8691: int *ci,*ri;
8692: Z dn;
8693: MAT m,nm;
8694:
8695: NEWMAT(m); m->row = row; m->col = col; m->body = (pointer **)mat0;
8696: rank = generic_gauss_elim(m,&nm,&dn,&ri,&ci);
8697: for ( i = 0; i < row; i++ )
8698: for ( j = 0; j < col; j++ )
8699: mat0[i][j] = 0;
8700: c = col-rank;
8701: for ( i = 0; i < rank; i++ ) {
8702: mat0[i][ri[i]] = dn;
8703: for ( j = 0; j < c; j++ )
8704: mat0[i][ci[j]] = (Z)BDY(nm)[i][j];
8705: }
8706: return rank;
8707: }
8708:
8709: int nd_gauss_elim_mod(UINT **mat0,int *sugar,ND_pairs *spactive,int row,int col,int md,int *colstat)
8710: {
8711: int i,j,k,l,inv,a,rank,s;
8712: unsigned int *t,*pivot,*pk;
8713: unsigned int **mat;
8714: ND_pairs pair;
8715:
8716: mat = (unsigned int **)mat0;
8717: for ( rank = 0, j = 0; j < col; j++ ) {
8718: for ( i = rank; i < row; i++ )
8719: mat[i][j] %= md;
8720: for ( i = rank; i < row; i++ )
8721: if ( mat[i][j] )
8722: break;
8723: if ( i == row ) {
8724: colstat[j] = 0;
8725: continue;
8726: } else
8727: colstat[j] = 1;
8728: if ( i != rank ) {
8729: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
8730: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
8731: if ( spactive ) {
8732: pair = spactive[i]; spactive[i] = spactive[rank];
8733: spactive[rank] = pair;
8734: }
8735: }
8736: pivot = mat[rank];
8737: s = sugar[rank];
8738: inv = invm(pivot[j],md);
8739: for ( k = j, pk = pivot+k; k < col; k++, pk++ )
8740: if ( *pk ) {
8741: if ( *pk >= (unsigned int)md )
8742: *pk %= md;
8743: DMAR(*pk,inv,0,md,*pk)
8744: }
8745: for ( i = rank+1; i < row; i++ ) {
8746: t = mat[i];
8747: if ( (a = t[j]) != 0 ) {
8748: sugar[i] = MAX(sugar[i],s);
8749: red_by_vect(md,t+j,pivot+j,md-a,col-j);
8750: }
8751: }
8752: rank++;
8753: }
8754: for ( j = col-1, l = rank-1; j >= 0; j-- )
8755: if ( colstat[j] ) {
8756: pivot = mat[l];
8757: s = sugar[l];
8758: for ( i = 0; i < l; i++ ) {
8759: t = mat[i];
8760: t[j] %= md;
8761: if ( (a = t[j]) != 0 ) {
8762: sugar[i] = MAX(sugar[i],s);
8763: red_by_vect(md,t+j,pivot+j,md-a,col-j);
8764: }
8765: }
8766: l--;
8767: }
8768: for ( j = 0, l = 0; l < rank; j++ )
8769: if ( colstat[j] ) {
8770: t = mat[l];
8771: for ( k = j; k < col; k++ )
8772: if ( t[k] >= (unsigned int)md )
8773: t[k] %= md;
8774: l++;
8775: }
8776: return rank;
8777: }
8778:
8779:
1.7 noro 8780: int nd_gauss_elim_sf(UINT **mat0,int *sugar,int row,int col,int md,int *colstat)
1.1 noro 8781: {
1.7 noro 8782: int i,j,k,l,inv,a,rank,s;
8783: unsigned int *t,*pivot,*pk;
8784: unsigned int **mat;
8785:
8786: mat = (unsigned int **)mat0;
8787: for ( rank = 0, j = 0; j < col; j++ ) {
8788: for ( i = rank; i < row; i++ )
8789: if ( mat[i][j] )
8790: break;
8791: if ( i == row ) {
8792: colstat[j] = 0;
8793: continue;
8794: } else
8795: colstat[j] = 1;
8796: if ( i != rank ) {
8797: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
8798: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
8799: }
8800: pivot = mat[rank];
8801: s = sugar[rank];
8802: inv = _invsf(pivot[j]);
8803: for ( k = j, pk = pivot+k; k < col; k++, pk++ )
8804: if ( *pk )
8805: *pk = _mulsf(*pk,inv);
8806: for ( i = rank+1; i < row; i++ ) {
8807: t = mat[i];
8808: if ( (a = t[j]) != 0 ) {
8809: sugar[i] = MAX(sugar[i],s);
8810: red_by_vect_sf(md,t+j,pivot+j,_chsgnsf(a),col-j);
8811: }
8812: }
8813: rank++;
8814: }
8815: for ( j = col-1, l = rank-1; j >= 0; j-- )
8816: if ( colstat[j] ) {
8817: pivot = mat[l];
8818: s = sugar[l];
8819: for ( i = 0; i < l; i++ ) {
8820: t = mat[i];
8821: if ( (a = t[j]) != 0 ) {
8822: sugar[i] = MAX(sugar[i],s);
8823: red_by_vect_sf(md,t+j,pivot+j,_chsgnsf(a),col-j);
8824: }
8825: }
8826: l--;
8827: }
8828: return rank;
8829: }
1.1 noro 8830:
1.7 noro 8831: int ndv_ishomo(NDV p)
8832: {
8833: NMV m;
8834: int len,h;
1.1 noro 8835:
8836: if ( !p ) return 1;
8837: len = LEN(p);
8838: m = BDY(p);
8839: h = TD(DL(m));
8840: NMV_ADV(m);
8841: for ( len--; len; len--, NMV_ADV(m) )
1.20 noro 8842: if ( TD(DL(m)) != h ) {
8843: return 0;
8844: }
1.1 noro 8845: return 1;
8846: }
8847:
8848: void ndv_save(NDV p,int index)
8849: {
8850: FILE *s;
8851: char name[BUFSIZ];
8852: short id;
8853: int nv,sugar,len,n,i,td,e,j;
8854: NMV m;
8855: unsigned int *dl;
8856: int mpos;
8857:
8858: sprintf(name,"%s/%d",Demand,index);
8859: s = fopen(name,"w");
8860: savevl(s,0);
8861: if ( !p ) {
8862: saveobj(s,0);
8863: return;
8864: }
8865: id = O_DP;
8866: nv = NV(p);
8867: sugar = SG(p);
8868: len = LEN(p);
8869: write_short(s,(unsigned short *)&id); write_int(s,(unsigned int *)&nv); write_int(s,(unsigned int *)&sugar);
8870: write_int(s,(unsigned int *)&len);
8871:
8872: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
1.6 noro 8873: saveobj(s,(Obj)CZ(m));
1.1 noro 8874: dl = DL(m);
8875: td = TD(dl);
8876: write_int(s,(unsigned int *)&td);
8877: for ( j = 0; j < nv; j++ ) {
8878: e = GET_EXP(dl,j);
8879: write_int(s,(unsigned int *)&e);
8880: }
8881: if ( nd_module ) {
8882: mpos = MPOS(dl); write_int(s,(unsigned int *)&mpos);
8883: }
8884: }
8885: fclose(s);
8886: }
8887:
8888: void nd_save_mod(ND p,int index)
8889: {
8890: FILE *s;
8891: char name[BUFSIZ];
8892: int nv,sugar,len,c;
8893: NM m;
8894:
8895: sprintf(name,"%s/%d",Demand,index);
8896: s = fopen(name,"w");
8897: if ( !p ) {
8898: len = 0;
8899: write_int(s,(unsigned int *)&len);
8900: fclose(s);
8901: return;
8902: }
8903: nv = NV(p);
8904: sugar = SG(p);
8905: len = LEN(p);
8906: write_int(s,(unsigned int *)&nv); write_int(s,(unsigned int *)&sugar); write_int(s,(unsigned int *)&len);
8907: for ( m = BDY(p); m; m = NEXT(m) ) {
8908: c = CM(m); write_int(s,(unsigned int *)&c);
8909: write_intarray(s,(unsigned int *)DL(m),nd_wpd);
8910: }
8911: fclose(s);
8912: }
8913:
8914: NDV ndv_load(int index)
8915: {
8916: FILE *s;
8917: char name[BUFSIZ];
8918: short id;
8919: int nv,sugar,len,n,i,td,e,j;
8920: NDV d;
8921: NMV m0,m;
8922: unsigned int *dl;
8923: Obj obj;
8924: int mpos;
8925:
8926: sprintf(name,"%s/%d",Demand,index);
8927: s = fopen(name,"r");
8928: if ( !s ) return 0;
8929:
8930: skipvl(s);
8931: read_short(s,(unsigned short *)&id);
8932: if ( !id ) return 0;
8933: read_int(s,(unsigned int *)&nv);
8934: read_int(s,(unsigned int *)&sugar);
8935: read_int(s,(unsigned int *)&len);
8936:
8937: m0 = m = MALLOC(len*nmv_adv);
8938: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
1.6 noro 8939: loadobj(s,&obj); CZ(m) = (Z)obj;
1.1 noro 8940: dl = DL(m);
8941: ndl_zero(dl);
8942: read_int(s,(unsigned int *)&td); TD(dl) = td;
8943: for ( j = 0; j < nv; j++ ) {
8944: read_int(s,(unsigned int *)&e);
8945: PUT_EXP(dl,j,e);
8946: }
8947: if ( nd_module ) {
8948: read_int(s,(unsigned int *)&mpos); MPOS(dl) = mpos;
8949: }
8950: if ( nd_blockmask ) ndl_weight_mask(dl);
8951: }
8952: fclose(s);
8953: MKNDV(nv,m0,len,d);
8954: SG(d) = sugar;
8955: return d;
8956: }
8957:
8958: ND nd_load_mod(int index)
8959: {
8960: FILE *s;
8961: char name[BUFSIZ];
8962: int nv,sugar,len,i,c;
8963: ND d;
8964: NM m0,m;
8965:
8966: sprintf(name,"%s/%d",Demand,index);
8967: s = fopen(name,"r");
8968: /* if the file does not exist, it means p[index]=0 */
8969: if ( !s ) return 0;
8970:
8971: read_int(s,(unsigned int *)&nv);
8972: if ( !nv ) { fclose(s); return 0; }
8973:
8974: read_int(s,(unsigned int *)&sugar);
8975: read_int(s,(unsigned int *)&len);
8976: for ( m0 = 0, i = 0; i < len; i++ ) {
8977: NEXTNM(m0,m);
8978: read_int(s,(unsigned int *)&c); CM(m) = c;
8979: read_intarray(s,(unsigned int *)DL(m),nd_wpd);
8980: }
8981: NEXT(m) = 0;
8982: MKND(nv,m0,len,d);
8983: SG(d) = sugar;
8984: fclose(s);
8985: return d;
8986: }
8987:
8988: void nd_det(int mod,MAT f,P *rp)
8989: {
8990: VL fv,tv;
8991: int n,i,j,max,e,nvar,sgn,k0,l0,len0,len,k,l,a;
8992: pointer **m;
8993: P **w;
8994: P mp,r;
8995: NDV **dm;
8996: NDV *t,*mi,*mj;
8997: NDV d,s,mij,mjj;
8998: ND u;
8999: NMV nmv;
9000: UINT *bound;
9001: PGeoBucket bucket;
9002: struct order_spec *ord;
9003: Z dq,dt,ds;
9004: Z mone;
9005: Z gn,qn,dn0,nm,dn;
9006:
9007: create_order_spec(0,0,&ord);
9008: nd_init_ord(ord);
9009: get_vars((Obj)f,&fv);
9010: if ( f->row != f->col )
9011: error("nd_det : non-square matrix");
9012: n = f->row;
9013: m = f->body;
9014: for ( nvar = 0, tv = fv; tv; tv = NEXT(tv), nvar++ );
9015:
9016: if ( !nvar ) {
9017: if ( !mod )
9018: detp(CO,(P **)m,n,rp);
9019: else {
9020: w = (P **)almat_pointer(n,n);
9021: for ( i = 0; i < n; i++ )
9022: for ( j = 0; j < n; j++ )
9023: ptomp(mod,(P)m[i][j],&w[i][j]);
9024: detmp(CO,mod,w,n,&mp);
9025: mptop(mp,rp);
9026: }
9027: return;
9028: }
9029:
9030: if ( !mod ) {
9031: w = (P **)almat_pointer(n,n);
9032: dq = ONE;
9033: for ( i = 0; i < n; i++ ) {
9034: dn0 = ONE;
9035: for ( j = 0; j < n; j++ ) {
9036: if ( !m[i][j] ) continue;
9037: lgp(m[i][j],&nm,&dn);
1.6 noro 9038: gcdz(dn0,dn,&gn); divsz(dn0,gn,&qn); mulz(qn,dn,&dn0);
1.1 noro 9039: }
9040: if ( !UNIZ(dn0) ) {
9041: ds = dn0;
9042: for ( j = 0; j < n; j++ )
9043: mulp(CO,(P)m[i][j],(P)ds,&w[i][j]);
9044: mulz(dq,ds,&dt); dq = dt;
9045: } else
9046: for ( j = 0; j < n; j++ )
9047: w[i][j] = (P)m[i][j];
9048: }
9049: m = (pointer **)w;
9050: }
9051:
9052: for ( i = 0, max = 1; i < n; i++ )
9053: for ( j = 0; j < n; j++ )
9054: for ( tv = fv; tv; tv = NEXT(tv) ) {
9055: e = getdeg(tv->v,(P)m[i][j]);
9056: max = MAX(e,max);
9057: }
9058: nd_setup_parameters(nvar,max);
9059: dm = (NDV **)almat_pointer(n,n);
9060: for ( i = 0, max = 1; i < n; i++ )
9061: for ( j = 0; j < n; j++ ) {
9062: dm[i][j] = ptondv(CO,fv,m[i][j]);
9063: if ( mod ) ndv_mod(mod,dm[i][j]);
9064: if ( dm[i][j] && !LEN(dm[i][j]) ) dm[i][j] = 0;
9065: }
9066: d = ptondv(CO,fv,(P)ONE);
9067: if ( mod ) ndv_mod(mod,d);
9068: chsgnz(ONE,&mone);
9069: for ( j = 0, sgn = 1; j < n; j++ ) {
9070: if ( DP_Print ) {
9071: fprintf(asir_out,".");
9072: }
9073: for ( i = j; i < n && !dm[i][j]; i++ );
9074: if ( i == n ) {
9075: *rp = 0;
9076: return;
9077: }
9078: k0 = i; l0 = j; len0 = LEN(dm[k0][l0]);
9079: for ( k = j; k < n; k++ )
9080: for ( l = j; l < n; l++ )
9081: if ( dm[k][l] && LEN(dm[k][l]) < len0 ) {
9082: k0 = k; l0 = l; len0 = LEN(dm[k][l]);
9083: }
9084: if ( k0 != j ) {
9085: t = dm[j]; dm[j] = dm[k0]; dm[k0] = t;
9086: sgn = -sgn;
9087: }
9088: if ( l0 != j ) {
9089: for ( k = j; k < n; k++ ) {
9090: s = dm[k][j]; dm[k][j] = dm[k][l0]; dm[k][l0] = s;
9091: }
9092: sgn = -sgn;
9093: }
9094: bound = nd_det_compute_bound(dm,n,j);
9095: for ( k = 0; k < nd_nvar; k++ )
9096: if ( bound[k]*2 > nd_mask0 ) break;
9097: if ( k < nd_nvar )
9098: nd_det_reconstruct(dm,n,j,d);
9099:
9100: for ( i = j+1, mj = dm[j], mjj = mj[j]; i < n; i++ ) {
9101: /* if ( DP_Print ) fprintf(asir_out," i=%d\n ",i); */
9102: mi = dm[i]; mij = mi[j];
9103: if ( mod )
9104: ndv_mul_c(mod,mij,mod-1);
9105: else
9106: ndv_mul_c_q(mij,mone);
9107: for ( k = j+1; k < n; k++ ) {
9108: /* if ( DP_Print ) fprintf(asir_out,"k=%d ",k); */
9109: bucket = create_pbucket();
9110: if ( mi[k] ) {
9111: nmv = BDY(mjj); len = LEN(mjj);
9112: for ( a = 0; a < len; a++, NMV_ADV(nmv) ) {
9113: u = ndv_mul_nmv_trunc(mod,nmv,mi[k],DL(BDY(d)));
9114: add_pbucket(mod,bucket,u);
9115: }
9116: }
9117: if ( mj[k] && mij ) {
9118: nmv = BDY(mij); len = LEN(mij);
9119: for ( a = 0; a < len; a++, NMV_ADV(nmv) ) {
9120: u = ndv_mul_nmv_trunc(mod,nmv,mj[k],DL(BDY(d)));
9121: add_pbucket(mod,bucket,u);
9122: }
9123: }
9124: u = nd_quo(mod,bucket,d);
9125: mi[k] = ndtondv(mod,u);
9126: }
9127: /* if ( DP_Print ) fprintf(asir_out,"\n",k); */
9128: }
9129: d = mjj;
9130: }
9131: if ( DP_Print ) {
9132: fprintf(asir_out,"\n");
9133: }
9134: if ( sgn < 0 ) {
9135: if ( mod )
9136: ndv_mul_c(mod,d,mod-1);
9137: else
9138: ndv_mul_c_q(d,mone);
9139: }
9140: r = ndvtop(mod,CO,fv,d);
9141: if ( !mod && !UNIQ(dq) )
9142: divsp(CO,r,(P)dq,rp);
9143: else
9144: *rp = r;
9145: }
9146:
9147: ND ndv_mul_nmv_trunc(int mod,NMV m0,NDV p,UINT *d)
9148: {
9149: NM mr,mr0;
9150: NM tnm;
9151: NMV m;
9152: UINT *d0,*dt,*dm;
9153: int c,n,td,i,c1,c2,len;
9154: Z q;
9155: ND r;
9156:
9157: if ( !p ) return 0;
9158: else {
9159: n = NV(p); m = BDY(p); len = LEN(p);
9160: d0 = DL(m0);
9161: td = TD(d);
9162: mr0 = 0;
9163: NEWNM(tnm);
9164: if ( mod ) {
9165: c = CM(m0);
9166: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
9167: ndl_add(DL(m),d0,DL(tnm));
9168: if ( ndl_reducible(DL(tnm),d) ) {
9169: NEXTNM(mr0,mr);
9170: c1 = CM(m); DMAR(c1,c,0,mod,c2); CM(mr) = c2;
9171: ndl_copy(DL(tnm),DL(mr));
9172: }
9173: }
9174: } else {
1.6 noro 9175: q = CZ(m0);
1.1 noro 9176: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
9177: ndl_add(DL(m),d0,DL(tnm));
9178: if ( ndl_reducible(DL(tnm),d) ) {
9179: NEXTNM(mr0,mr);
1.6 noro 9180: mulz(CZ(m),q,&CZ(mr));
1.1 noro 9181: ndl_copy(DL(tnm),DL(mr));
9182: }
9183: }
9184: }
9185: if ( !mr0 )
9186: return 0;
9187: else {
9188: NEXT(mr) = 0;
9189: for ( len = 0, mr = mr0; mr; mr = NEXT(mr), len++ );
9190: MKND(NV(p),mr0,len,r);
9191: SG(r) = SG(p) + TD(d0);
9192: return r;
9193: }
9194: }
9195: }
9196:
9197: void nd_det_reconstruct(NDV **dm,int n,int j,NDV d)
9198: {
9199: int i,obpe,oadv,h,k,l;
9200: static NM prev_nm_free_list;
9201: EPOS oepos;
9202:
9203: obpe = nd_bpe;
9204: oadv = nmv_adv;
9205: oepos = nd_epos;
9206: if ( obpe < 2 ) nd_bpe = 2;
9207: else if ( obpe < 3 ) nd_bpe = 3;
9208: else if ( obpe < 4 ) nd_bpe = 4;
9209: else if ( obpe < 5 ) nd_bpe = 5;
9210: else if ( obpe < 6 ) nd_bpe = 6;
9211: else if ( obpe < 8 ) nd_bpe = 8;
9212: else if ( obpe < 10 ) nd_bpe = 10;
9213: else if ( obpe < 16 ) nd_bpe = 16;
9214: else if ( obpe < 32 ) nd_bpe = 32;
9215: else error("nd_det_reconstruct : exponent too large");
9216:
9217: nd_setup_parameters(nd_nvar,0);
9218: prev_nm_free_list = _nm_free_list;
9219: _nm_free_list = 0;
9220: for ( k = j; k < n; k++ )
9221: for (l = j; l < n; l++ )
9222: ndv_realloc(dm[k][l],obpe,oadv,oepos);
9223: ndv_realloc(d,obpe,oadv,oepos);
9224: prev_nm_free_list = 0;
9225: #if 0
9226: GC_gcollect();
9227: #endif
9228: }
9229:
9230: /* returns a UINT array containing degree bounds */
9231:
9232: UINT *nd_det_compute_bound(NDV **dm,int n,int j)
9233: {
9234: UINT *d0,*d1,*d,*t,*r;
9235: int k,l,i;
9236:
9237: d0 = (UINT *)MALLOC(nd_nvar*sizeof(UINT));
9238: for ( k = 0; k < nd_nvar; k++ ) d0[k] = 0;
9239: for ( k = j; k < n; k++ )
9240: for ( l = j; l < n; l++ )
9241: if ( dm[k][l] ) {
9242: d = ndv_compute_bound(dm[k][l]);
9243: for ( i = 0; i < nd_nvar; i++ )
9244: d0[i] = MAX(d0[i],d[i]);
9245: }
9246: return d0;
9247: }
9248:
9249: DL nd_separate_d(UINT *d,UINT *trans)
9250: {
9251: int n,td,i,e,j;
9252: DL a;
9253:
9254: ndl_zero(trans);
9255: td = 0;
9256: for ( i = 0; i < nd_ntrans; i++ ) {
9257: e = GET_EXP(d,i);
9258: PUT_EXP(trans,i,e);
9259: td += MUL_WEIGHT(e,i);
9260: }
9261: if ( nd_ntrans+nd_nalg < nd_nvar ) {
9262: /* homogenized */
9263: i = nd_nvar-1;
9264: e = GET_EXP(d,i);
9265: PUT_EXP(trans,i,e);
9266: td += MUL_WEIGHT(e,i);
9267: }
9268: TD(trans) = td;
9269: if ( nd_blockmask) ndl_weight_mask(trans);
9270: NEWDL(a,nd_nalg);
9271: td = 0;
9272: for ( i = 0; i < nd_nalg; i++ ) {
9273: j = nd_ntrans+i;
9274: e = GET_EXP(d,j);
9275: a->d[i] = e;
9276: td += e;
9277: }
9278: a->td = td;
9279: return a;
9280: }
9281:
9282: int nd_monic(int mod,ND *p)
9283: {
9284: UINT *trans,*t;
9285: DL alg;
9286: MP mp0,mp;
9287: NM m,m0,m1,ma0,ma,mb,mr0,mr;
9288: ND r;
9289: DL dl;
9290: DP nm;
9291: NDV ndv;
9292: DAlg inv,cd;
9293: ND s,c;
9294: Z l,mul;
9295: Z ln;
9296: int n,ntrans,i,e,td,is_lc,len;
9297: NumberField nf;
9298: struct oEGT eg0,eg1;
9299:
9300: if ( !(nf = get_numberfield()) )
9301: error("nd_monic : current_numberfield is not set");
9302:
9303: /* Q coef -> DAlg coef */
9304: NEWNM(ma0); ma = ma0;
9305: m = BDY(*p);
9306: is_lc = 1;
9307: while ( 1 ) {
9308: NEWMP(mp0); mp = mp0;
1.6 noro 9309: mp->c = (Obj)CZ(m);
1.1 noro 9310: mp->dl = nd_separate_d(DL(m),DL(ma));
9311: NEWNM(mb);
9312: for ( m = NEXT(m); m; m = NEXT(m) ) {
9313: alg = nd_separate_d(DL(m),DL(mb));
9314: if ( !ndl_equal(DL(ma),DL(mb)) )
9315: break;
1.6 noro 9316: NEXTMP(mp0,mp); mp->c = (Obj)CZ(m); mp->dl = alg;
1.1 noro 9317: }
9318: NEXT(mp) = 0;
9319: MKDP(nd_nalg,mp0,nm);
9320: MKDAlg(nm,ONE,cd);
9321: if ( is_lc == 1 ) {
9322: /* if the lc is a rational number, we have nothing to do */
9323: if ( !mp0->dl->td )
9324: return 1;
9325:
9326: get_eg(&eg0);
9327: invdalg(cd,&inv);
9328: get_eg(&eg1); add_eg(&eg_invdalg,&eg0,&eg1);
9329: /* check the validity of inv */
9330: if ( mod && !remqi((Q)inv->dn,mod) )
9331: return 0;
9332: CA(ma) = nf->one;
9333: is_lc = 0;
9334: ln = ONE;
9335: } else {
9336: muldalg(cd,inv,&CA(ma));
9337: lcmz(ln,CA(ma)->dn,&ln);
9338: }
9339: if ( m ) {
9340: NEXT(ma) = mb; ma = mb;
9341: } else {
9342: NEXT(ma) = 0;
9343: break;
9344: }
9345: }
9346: /* l = lcm(denoms) */
9347: l = ln;
9348: for ( mr0 = 0, m = ma0; m; m = NEXT(m) ) {
1.6 noro 9349: divsz(l,CA(m)->dn,&mul);
1.1 noro 9350: for ( mp = BDY(CA(m)->nm); mp; mp = NEXT(mp) ) {
9351: NEXTNM(mr0,mr);
1.6 noro 9352: mulz((Z)mp->c,mul,&CZ(mr));
1.1 noro 9353: dl = mp->dl;
9354: td = TD(DL(m));
9355: ndl_copy(DL(m),DL(mr));
9356: for ( i = 0; i < nd_nalg; i++ ) {
9357: e = dl->d[i];
9358: PUT_EXP(DL(mr),i+nd_ntrans,e);
9359: td += MUL_WEIGHT(e,i+nd_ntrans);
9360: }
9361: if ( nd_module ) MPOS(DL(mr)) = MPOS(DL(m));
9362: TD(DL(mr)) = td;
9363: if ( nd_blockmask) ndl_weight_mask(DL(mr));
9364: }
9365: }
9366: NEXT(mr) = 0;
9367: for ( len = 0, mr = mr0; mr; mr = NEXT(mr), len++ );
9368: MKND(NV(*p),mr0,len,r);
9369: /* XXX */
9370: SG(r) = SG(*p);
9371: nd_free(*p);
9372: *p = r;
9373: return 1;
9374: }
9375:
9376: NODE reverse_node(NODE n)
9377: {
9378: NODE t,t1;
9379:
9380: for ( t = 0; n; n = NEXT(n) ) {
9381: MKNODE(t1,BDY(n),t); t = t1;
9382: }
9383: return t;
9384: }
9385:
9386: P ndc_div(int mod,union oNDC a,union oNDC b)
9387: {
9388: union oNDC c;
9389: int inv,t;
9390:
9391: if ( mod == -1 ) c.m = _mulsf(a.m,_invsf(b.m));
1.10 noro 9392: else if ( mod == -2 ) divlf(a.z,b.z,&c.z);
1.1 noro 9393: else if ( mod ) {
9394: inv = invm(b.m,mod);
9395: DMAR(a.m,inv,0,mod,t); c.m = t;
9396: } else if ( nd_vc )
9397: divsp(nd_vc,a.p,b.p,&c.p);
9398: else
9399: divsz(a.z,b.z,&c.z);
9400: return ndctop(mod,c);
9401: }
9402:
9403: P ndctop(int mod,union oNDC c)
9404: {
9405: Z q;
9406: int e;
9407: GFS gfs;
9408:
9409: if ( mod == -1 ) {
9410: e = IFTOF(c.m); MKGFS(e,gfs); return (P)gfs;
9411: } else if ( mod == -2 ) {
1.10 noro 9412: q = c.z; return (P)q;
1.1 noro 9413: } else if ( mod > 0 ) {
1.6 noro 9414: STOZ(c.m,q); return (P)q;
1.1 noro 9415: } else
9416: return (P)c.p;
9417: }
9418:
9419: /* [0,0,0,cont] = p -> p/cont */
9420:
9421: void finalize_tracelist(int i,P cont)
9422: {
9423: LIST l;
9424: NODE node;
9425: Z iq;
9426:
9427: if ( !UNIQ(cont) ) {
9428: node = mknode(4,NULLP,NULLP,NULLP,cont);
9429: MKLIST(l,node); MKNODE(node,l,nd_tracelist);
9430: nd_tracelist = node;
9431: }
1.6 noro 9432: STOZ(i,iq);
1.1 noro 9433: nd_tracelist = reverse_node(nd_tracelist);
9434: MKLIST(l,nd_tracelist);
9435: node = mknode(2,iq,l); MKLIST(l,node);
9436: MKNODE(node,l,nd_alltracelist); MKLIST(l,node);
9437: nd_alltracelist = node; nd_tracelist = 0;
9438: }
9439:
9440: void conv_ilist(int demand,int trace,NODE g,int **indp)
9441: {
9442: int n,i,j;
9443: int *ind;
9444: NODE t;
9445:
9446: n = length(g);
9447: ind = (int *)MALLOC(n*sizeof(int));
9448: for ( i = 0, t = g; i < n; i++, t = NEXT(t) ) {
9449: j = (long)BDY(t); ind[i] = j;
9450: BDY(t) = (pointer)(demand?ndv_load(j):(trace?nd_ps_trace[j]:nd_ps[j]));
9451: }
9452: if ( indp ) *indp = ind;
9453: }
9454:
9455: void parse_nd_option(NODE opt)
9456: {
9457: NODE t,p,u;
9458: int i,s,n;
9459: char *key;
9460: Obj value;
9461:
9462: nd_gentrace = 0; nd_gensyz = 0; nd_nora = 0; nd_gbblock = 0;
9463: nd_newelim = 0; nd_intersect = 0; nd_nzlist = 0;
9464: nd_splist = 0; nd_check_splist = 0;
9465: nd_sugarweight = 0;
9466: nd_f4red =0;
9467: nd_rank0 = 0;
9468: for ( t = opt; t; t = NEXT(t) ) {
9469: p = BDY((LIST)BDY(t));
9470: key = BDY((STRING)BDY(p));
9471: value = (Obj)BDY(NEXT(p));
9472: if ( !strcmp(key,"gentrace") )
9473: nd_gentrace = value?1:0;
9474: else if ( !strcmp(key,"gensyz") )
9475: nd_gensyz = value?1:0;
9476: else if ( !strcmp(key,"nora") )
9477: nd_nora = value?1:0;
9478: else if ( !strcmp(key,"gbblock") ) {
9479: if ( value && OID(value) == O_LIST ) {
9480: u = BDY((LIST)value);
9481: nd_gbblock = MALLOC((2*length(u)+1)*sizeof(int));
9482: for ( i = 0; u; u = NEXT(u) ) {
9483: p = BDY((LIST)BDY(u));
1.6 noro 9484: s = nd_gbblock[i++] = ZTOS((Q)BDY(p));
9485: nd_gbblock[i++] = s+ZTOS((Q)BDY(NEXT(p)))-1;
1.1 noro 9486: }
9487: nd_gbblock[i] = -1;
9488: } else
9489: nd_gbblock = 0;
9490: } else if ( !strcmp(key,"newelim") )
9491: nd_newelim = value?1:0;
9492: else if ( !strcmp(key,"intersect") )
9493: nd_intersect = value?1:0;
1.17 noro 9494: else if ( !strcmp(key,"syzgen") )
9495: nd_intersect = ZTOS((Q)value);
1.1 noro 9496: else if ( !strcmp(key,"lf") )
9497: nd_lf = value?1:0;
9498: else if ( !strcmp(key,"trace") ) {
9499: if ( value ) {
9500: u = BDY((LIST)value);
9501: nd_nzlist = BDY((LIST)ARG2(u));
1.6 noro 9502: nd_bpe = ZTOS((Q)ARG3(u));
1.1 noro 9503: }
9504: } else if ( !strcmp(key,"f4red") ) {
1.6 noro 9505: nd_f4red = ZTOS((Q)value);
1.1 noro 9506: } else if ( !strcmp(key,"rank0") ) {
9507: nd_rank0 = value?1:0;
9508: } else if ( !strcmp(key,"splist") ) {
9509: nd_splist = value?1:0;
9510: } else if ( !strcmp(key,"check_splist") ) {
9511: nd_check_splist = BDY((LIST)value);
9512: } else if ( !strcmp(key,"sugarweight") ) {
9513: u = BDY((LIST)value);
9514: n = length(u);
9515: nd_sugarweight = MALLOC(n*sizeof(int));
9516: for ( i = 0; i < n; i++, u = NEXT(u) )
1.6 noro 9517: nd_sugarweight[i] = ZTOS((Q)BDY(u));
1.1 noro 9518: }
9519: }
9520: }
9521:
9522: ND mdptond(DP d);
9523: ND nd_mul_nm(int mod,NM m0,ND p);
9524: ND nd_mul_nm_lf(NM m0,ND p);
9525: ND *btog(NODE ti,ND **p,int nb,int mod);
9526: ND btog_one(NODE ti,ND *p,int nb,int mod);
9527: MAT nd_btog(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,MAT *rp);
9528: VECT nd_btog_one(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,int pos,MAT *rp);
9529:
9530: /* d:monomial */
9531: ND mdptond(DP d)
9532: {
9533: NM m;
9534: ND r;
9535:
9536: if ( OID(d) == 1 )
9537: r = ptond(CO,CO,(P)d);
9538: else {
9539: NEWNM(m);
9540: dltondl(NV(d),BDY(d)->dl,DL(m));
1.6 noro 9541: CZ(m) = (Z)BDY(d)->c;
1.1 noro 9542: NEXT(m) = 0;
9543: MKND(NV(d),m,1,r);
9544: }
9545: return r;
9546: }
9547:
9548: ND nd_mul_nm(int mod,NM m0,ND p)
9549: {
9550: UINT *d0;
9551: int c0,c1,c;
9552: NM tm,mr,mr0;
9553: ND r;
9554:
9555: if ( !p ) return 0;
9556: d0 = DL(m0);
9557: c0 = CM(m0);
9558: mr0 = 0;
9559: for ( tm = BDY(p); tm; tm = NEXT(tm) ) {
9560: NEXTNM(mr0,mr);
9561: c = CM(tm); DMAR(c0,c,0,mod,c1); CM(mr) = c1;
9562: ndl_add(d0,DL(tm),DL(mr));
9563: }
9564: NEXT(mr) = 0;
9565: MKND(NV(p),mr0,LEN(p),r);
9566: return r;
9567: }
9568:
9569: ND nd_mul_nm_lf(NM m0,ND p)
9570: {
9571: UINT *d0;
9572: Z c0,c1,c;
9573: NM tm,mr,mr0;
9574: ND r;
9575:
9576: if ( !p ) return 0;
9577: d0 = DL(m0);
9578: c0 = CZ(m0);
9579: mr0 = 0;
9580: for ( tm = BDY(p); tm; tm = NEXT(tm) ) {
9581: NEXTNM(mr0,mr);
9582: c = CZ(tm); mullf(c0,CZ(tm),&c1); CZ(mr) = c1;
9583: ndl_add(d0,DL(tm),DL(mr));
9584: }
9585: NEXT(mr) = 0;
9586: MKND(NV(p),mr0,LEN(p),r);
9587: return r;
9588: }
9589:
9590: ND *btog(NODE ti,ND **p,int nb,int mod)
9591: {
9592: PGeoBucket *r;
9593: int i,ci;
9594: NODE t,s;
9595: ND m,tp;
9596: ND *pi,*rd;
9597: P c;
9598:
9599: r = (PGeoBucket *)MALLOC(nb*sizeof(PGeoBucket));
9600: for ( i = 0; i < nb; i++ )
9601: r[i] = create_pbucket();
9602: for ( t = ti; t; t = NEXT(t) ) {
9603: s = BDY((LIST)BDY(t));
9604: if ( ARG0(s) ) {
9605: m = mdptond((DP)ARG2(s));
1.6 noro 9606: ptomp(mod,(P)HCZ(m),&c);
1.1 noro 9607: if ( (ci = ((MQ)c)->cont) != 0 ) {
9608: HCM(m) = ci;
1.6 noro 9609: pi = p[ZTOS((Q)ARG1(s))];
1.1 noro 9610: for ( i = 0; i < nb; i++ ) {
9611: tp = nd_mul_nm(mod,BDY(m),pi[i]);
9612: add_pbucket(mod,r[i],tp);
9613: }
9614: }
9615: ci = 1;
9616: } else {
9617: ptomp(mod,(P)ARG3(s),&c); ci = ((MQ)c)->cont;
9618: ci = invm(ci,mod);
9619: }
9620: }
9621: rd = (ND *)MALLOC(nb*sizeof(ND));
9622: for ( i = 0; i < nb; i++ )
9623: rd[i] = normalize_pbucket(mod,r[i]);
9624: if ( ci != 1 )
9625: for ( i = 0; i < nb; i++ ) nd_mul_c(mod,rd[i],ci);
9626: return rd;
9627: }
9628:
9629: /* YYY */
9630: ND *btog_lf(NODE ti,ND **p,int nb)
9631: {
9632: PGeoBucket *r;
9633: int i;
9634: NODE t,s;
9635: ND m,tp;
9636: ND *pi,*rd;
9637: LM lm;
9638: Z lf,c;
9639:
9640: r = (PGeoBucket *)MALLOC(nb*sizeof(PGeoBucket));
9641: for ( i = 0; i < nb; i++ )
9642: r[i] = create_pbucket();
9643: for ( t = ti; t; t = NEXT(t) ) {
9644: s = BDY((LIST)BDY(t));
9645: if ( ARG0(s) ) {
9646: m = mdptond((DP)ARG2(s));
1.6 noro 9647: simp_ff((Obj)HCZ(m),(Obj *)&lm);
1.1 noro 9648: if ( lm ) {
9649: lmtolf(lm,&lf); HCZ(m) = lf;
1.6 noro 9650: pi = p[ZTOS((Q)ARG1(s))];
1.1 noro 9651: for ( i = 0; i < nb; i++ ) {
9652: tp = nd_mul_nm_lf(BDY(m),pi[i]);
9653: add_pbucket(-2,r[i],tp);
9654: }
9655: }
9656: c = ONE;
9657: } else {
9658: simp_ff((Obj)ARG3(s),(Obj *)&lm); lmtolf(lm,&lf); invz(lf,current_mod_lf,&c);
9659: }
9660: }
9661: rd = (ND *)MALLOC(nb*sizeof(ND));
9662: for ( i = 0; i < nb; i++ )
9663: rd[i] = normalize_pbucket(-2,r[i]);
9664: for ( i = 0; i < nb; i++ ) nd_mul_c_lf(rd[i],c);
9665: return rd;
9666: }
9667:
9668: ND btog_one(NODE ti,ND *p,int nb,int mod)
9669: {
9670: PGeoBucket r;
9671: int i,ci,j;
9672: NODE t,s;
9673: ND m,tp;
9674: ND pi,rd;
9675: P c;
9676:
9677: r = create_pbucket();
9678: for ( t = ti; t; t = NEXT(t) ) {
9679: s = BDY((LIST)BDY(t));
9680: if ( ARG0(s) ) {
9681: m = mdptond((DP)ARG2(s));
1.6 noro 9682: ptomp(mod,(P)HCZ(m),&c);
1.1 noro 9683: if ( (ci = ((MQ)c)->cont) != 0 ) {
9684: HCM(m) = ci;
1.6 noro 9685: pi = p[j=ZTOS((Q)ARG1(s))];
1.1 noro 9686: if ( !pi ) {
9687: pi = nd_load_mod(j);
9688: tp = nd_mul_nm(mod,BDY(m),pi);
9689: nd_free(pi);
9690: add_pbucket(mod,r,tp);
9691: } else {
9692: tp = nd_mul_nm(mod,BDY(m),pi);
9693: add_pbucket(mod,r,tp);
9694: }
9695: }
9696: ci = 1;
9697: } else {
9698: ptomp(mod,(P)ARG3(s),&c); ci = ((MQ)c)->cont;
9699: ci = invm(ci,mod);
9700: }
9701: }
9702: rd = normalize_pbucket(mod,r);
9703: free_pbucket(r);
9704: if ( ci != 1 ) nd_mul_c(mod,rd,ci);
9705: return rd;
9706: }
9707:
9708: MAT nd_btog_lf(LIST f,LIST v,struct order_spec *ord,LIST tlist,MAT *rp);
9709:
9710: MAT nd_btog(LIST f,LIST v,int mod,struct order_spec *ord,LIST tlist,MAT *rp)
9711: {
9712: int i,j,n,m,nb,pi0,pi1,nvar;
9713: VL fv,tv,vv;
9714: NODE permtrace,perm,trace,intred,ind,t,pi,ti;
9715: ND **p;
9716: ND *c;
9717: ND u;
9718: P inv;
9719: MAT mat;
9720:
9721: if ( mod == -2 )
9722: return nd_btog_lf(f,v,ord,tlist,rp);
9723:
9724: parse_nd_option(current_option);
9725: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
9726: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
9727: switch ( ord->id ) {
9728: case 1:
9729: if ( ord->nv != nvar )
9730: error("nd_check : invalid order specification");
9731: break;
9732: default:
9733: break;
9734: }
9735: nd_init_ord(ord);
9736: #if 0
1.6 noro 9737: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 9738: #else
9739: nd_bpe = 32;
9740: #endif
9741: nd_setup_parameters(nvar,0);
9742: permtrace = BDY((LIST)ARG2(BDY(tlist)));
9743: intred = BDY((LIST)ARG3(BDY(tlist)));
9744: ind = BDY((LIST)ARG4(BDY(tlist)));
9745: perm = BDY((LIST)BDY(permtrace)); trace =NEXT(permtrace);
9746: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 9747: j = ZTOS((Q)BDY(BDY((LIST)BDY(t))));
1.1 noro 9748: if ( j > i ) i = j;
9749: }
9750: n = i+1;
9751: nb = length(BDY(f));
9752: p = (ND **)MALLOC(n*sizeof(ND *));
9753: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
9754: pi = BDY((LIST)BDY(t));
1.6 noro 9755: pi0 = ZTOS((Q)ARG0(pi)); pi1 = ZTOS((Q)ARG1(pi));
1.1 noro 9756: p[pi0] = c = (ND *)MALLOC(nb*sizeof(ND));
9757: ptomp(mod,(P)ARG2(pi),&inv);
9758: ((MQ)inv)->cont = invm(((MQ)inv)->cont,mod);
9759: u = ptond(CO,vv,(P)ONE);
9760: HCM(u) = ((MQ)inv)->cont;
9761: c[pi1] = u;
9762: }
9763: for ( t = trace,i=0; t; t = NEXT(t), i++ ) {
9764: printf("%d ",i); fflush(stdout);
9765: ti = BDY((LIST)BDY(t));
1.6 noro 9766: p[j=ZTOS((Q)ARG0(ti))] = btog(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 9767: }
9768: for ( t = intred, i=0; t; t = NEXT(t), i++ ) {
9769: printf("%d ",i); fflush(stdout);
9770: ti = BDY((LIST)BDY(t));
1.6 noro 9771: p[j=ZTOS((Q)ARG0(ti))] = btog(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 9772: }
9773: m = length(ind);
9774: MKMAT(mat,nb,m);
9775: for ( j = 0, t = ind; j < m; j++, t = NEXT(t) )
1.6 noro 9776: for ( i = 0, c = p[ZTOS((Q)BDY(t))]; i < nb; i++ )
1.1 noro 9777: BDY(mat)[i][j] = ndtodp(mod,c[i]);
9778: return mat;
9779: }
9780:
9781: MAT nd_btog_lf(LIST f,LIST v,struct order_spec *ord,LIST tlist,MAT *rp)
9782: {
9783: int i,j,n,m,nb,pi0,pi1,nvar;
9784: VL fv,tv,vv;
9785: NODE permtrace,perm,trace,intred,ind,t,pi,ti;
9786: ND **p;
9787: ND *c;
9788: ND u;
9789: MAT mat;
9790: LM lm;
9791: Z lf,inv;
9792:
9793: parse_nd_option(current_option);
9794: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
9795: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
9796: switch ( ord->id ) {
9797: case 1:
9798: if ( ord->nv != nvar )
9799: error("nd_check : invalid order specification");
9800: break;
9801: default:
9802: break;
9803: }
9804: nd_init_ord(ord);
9805: #if 0
1.6 noro 9806: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 9807: #else
9808: nd_bpe = 32;
9809: #endif
9810: nd_setup_parameters(nvar,0);
9811: permtrace = BDY((LIST)ARG2(BDY(tlist)));
9812: intred = BDY((LIST)ARG3(BDY(tlist)));
9813: ind = BDY((LIST)ARG4(BDY(tlist)));
9814: perm = BDY((LIST)BDY(permtrace)); trace =NEXT(permtrace);
9815: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 9816: j = ZTOS((Q)BDY(BDY((LIST)BDY(t))));
1.1 noro 9817: if ( j > i ) i = j;
9818: }
9819: n = i+1;
9820: nb = length(BDY(f));
9821: p = (ND **)MALLOC(n*sizeof(ND *));
9822: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
9823: pi = BDY((LIST)BDY(t));
1.6 noro 9824: pi0 = ZTOS((Q)ARG0(pi)); pi1 = ZTOS((Q)ARG1(pi));
1.1 noro 9825: p[pi0] = c = (ND *)MALLOC(nb*sizeof(ND));
9826: simp_ff((Obj)ARG2(pi),(Obj *)&lm); lmtolf(lm,&lf); invz(lf,current_mod_lf,&inv);
9827: u = ptond(CO,vv,(P)ONE);
9828: HCZ(u) = inv;
9829: c[pi1] = u;
9830: }
9831: for ( t = trace,i=0; t; t = NEXT(t), i++ ) {
9832: printf("%d ",i); fflush(stdout);
9833: ti = BDY((LIST)BDY(t));
1.6 noro 9834: p[j=ZTOS((Q)ARG0(ti))] = btog_lf(BDY((LIST)ARG1(ti)),p,nb);
1.1 noro 9835: }
9836: for ( t = intred, i=0; t; t = NEXT(t), i++ ) {
9837: printf("%d ",i); fflush(stdout);
9838: ti = BDY((LIST)BDY(t));
1.6 noro 9839: p[j=ZTOS((Q)ARG0(ti))] = btog_lf(BDY((LIST)ARG1(ti)),p,nb);
1.1 noro 9840: }
9841: m = length(ind);
9842: MKMAT(mat,nb,m);
9843: for ( j = 0, t = ind; j < m; j++, t = NEXT(t) )
1.6 noro 9844: for ( i = 0, c = p[ZTOS((Q)BDY(t))]; i < nb; i++ )
1.1 noro 9845: BDY(mat)[i][j] = ndtodp(-2,c[i]);
9846: return mat;
9847: }
9848:
9849: VECT nd_btog_one(LIST f,LIST v,int mod,struct order_spec *ord,
9850: LIST tlist,int pos,MAT *rp)
9851: {
9852: int i,j,n,m,nb,pi0,pi1,nvar;
9853: VL fv,tv,vv;
9854: NODE permtrace,perm,trace,intred,ind,t,pi,ti;
9855: ND *p;
9856: ND *c;
9857: ND u;
9858: P inv;
9859: VECT vect;
9860:
9861: if ( mod == -2 )
9862: error("nd_btog_one : not implemented yet for a large finite field");
9863:
9864: parse_nd_option(current_option);
9865: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
9866: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
9867: switch ( ord->id ) {
9868: case 1:
9869: if ( ord->nv != nvar )
9870: error("nd_check : invalid order specification");
9871: break;
9872: default:
9873: break;
9874: }
9875: nd_init_ord(ord);
9876: #if 0
1.6 noro 9877: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 9878: #else
9879: nd_bpe = 32;
9880: #endif
9881: nd_setup_parameters(nvar,0);
9882: permtrace = BDY((LIST)ARG2(BDY(tlist)));
9883: intred = BDY((LIST)ARG3(BDY(tlist)));
9884: ind = BDY((LIST)ARG4(BDY(tlist)));
9885: perm = BDY((LIST)BDY(permtrace)); trace =NEXT(permtrace);
9886: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 9887: j = ZTOS((Q)BDY(BDY((LIST)BDY(t))));
1.1 noro 9888: if ( j > i ) i = j;
9889: }
9890: n = i+1;
9891: nb = length(BDY(f));
9892: p = (ND *)MALLOC(n*sizeof(ND *));
9893: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
9894: pi = BDY((LIST)BDY(t));
1.6 noro 9895: pi0 = ZTOS((Q)ARG0(pi)); pi1 = ZTOS((Q)ARG1(pi));
1.1 noro 9896: if ( pi1 == pos ) {
9897: ptomp(mod,(P)ARG2(pi),&inv);
9898: ((MQ)inv)->cont = invm(((MQ)inv)->cont,mod);
9899: u = ptond(CO,vv,(P)ONE);
9900: HCM(u) = ((MQ)inv)->cont;
9901: p[pi0] = u;
9902: }
9903: }
9904: for ( t = trace,i=0; t; t = NEXT(t), i++ ) {
9905: printf("%d ",i); fflush(stdout);
9906: ti = BDY((LIST)BDY(t));
1.6 noro 9907: p[j=ZTOS((Q)ARG0(ti))] = btog_one(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 9908: if ( Demand ) {
9909: nd_save_mod(p[j],j); nd_free(p[j]); p[j] = 0;
9910: }
9911: }
9912: for ( t = intred, i=0; t; t = NEXT(t), i++ ) {
9913: printf("%d ",i); fflush(stdout);
9914: ti = BDY((LIST)BDY(t));
1.6 noro 9915: p[j=ZTOS((Q)ARG0(ti))] = btog_one(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 9916: if ( Demand ) {
9917: nd_save_mod(p[j],j); nd_free(p[j]); p[j] = 0;
9918: }
9919: }
9920: m = length(ind);
9921: MKVECT(vect,m);
9922: for ( j = 0, t = ind; j < m; j++, t = NEXT(t) ) {
1.6 noro 9923: u = p[ZTOS((Q)BDY(t))];
1.1 noro 9924: if ( !u ) {
1.6 noro 9925: u = nd_load_mod(ZTOS((Q)BDY(t)));
1.1 noro 9926: BDY(vect)[j] = ndtodp(mod,u);
9927: nd_free(u);
9928: } else
9929: BDY(vect)[j] = ndtodp(mod,u);
9930: }
9931: return vect;
9932: }
9933:
9934: void ndv_print_lf(NDV p)
9935: {
9936: NMV m;
9937: int i,len;
9938:
9939: if ( !p ) printf("0\n");
9940: else {
9941: len = LEN(p);
9942: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
9943: printf("+");
9944: mpz_out_str(asir_out,10,BDY(CZ(m)));
9945: printf("*");
9946: ndl_print(DL(m));
9947: }
9948: printf("\n");
9949: }
9950: }
9951:
9952: void nd_f4_lf_trace(LIST f,LIST v,int trace,int homo,struct order_spec *ord,LIST *rp)
9953: {
9954: VL tv,fv,vv,vc,av;
9955: NODE fd,fd0,in0,in,r,r0,t,s,cand,alist;
9956: int m,nocheck,nvar,mindex,e,max;
9957: NDV c;
9958: NMV a;
9959: P p,zp;
9960: Q dmy;
9961: EPOS oepos;
9962: int obpe,oadv,wmax,i,len,cbpe,ishomo,nalg,mrank,trank,ompos;
9963: Alg alpha,dp;
9964: P poly;
9965: LIST f1,f2,zpl;
9966: Obj obj;
9967: NumberField nf;
9968: struct order_spec *ord1;
9969: struct oEGT eg_check,eg0,eg1;
9970: NODE tr,tl1,tl2,tl3,tl4;
9971: LIST l1,l2,l3,l4,l5;
9972: int *perm;
9973: int j,ret;
9974: NODE retn;
9975: Q jq,bpe;
9976:
9977: nd_module = 0;
9978: parse_nd_option(current_option);
9979: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
9980: if ( nd_vc )
9981: error("nd_f4_lf_trace : computation over a rational function field is not implemented");
9982: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
9983: switch ( ord->id ) {
9984: case 1:
9985: if ( ord->nv != nvar )
9986: error("nd_f4_lf_trace : invalid order specification");
9987: break;
9988: default:
9989: break;
9990: }
9991:
9992: nd_ntrans = nvar;
9993: nd_nalg = 0;
9994:
9995: nocheck = 0;
9996: mindex = 0;
9997:
9998: /* do not use on-demand load/save */
9999: nd_demand = 0;
10000: m = trace > 1 ? trace : get_lprime(mindex);
10001: nd_init_ord(ord);
10002: mrank = 0;
10003: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
10004: for ( tv = vv; tv; tv = NEXT(tv) ) {
10005: if ( nd_module ) {
10006: s = BDY((LIST)BDY(t));
10007: trank = length(s);
10008: mrank = MAX(mrank,trank);
10009: for ( ; s; s = NEXT(s) ) {
10010: e = getdeg(tv->v,(P)BDY(s));
10011: max = MAX(e,max);
10012: }
10013: } else {
10014: e = getdeg(tv->v,(P)BDY(t));
10015: max = MAX(e,max);
10016: }
10017: }
10018: nd_setup_parameters(nvar,max);
10019: obpe = nd_bpe; oadv = nmv_adv; oepos = nd_epos; ompos = nd_mpos;
10020: ishomo = 1;
10021: /* XXX */
10022: for ( in0 = 0, fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
10023: if ( nd_module ) {
10024: c = (pointer)pltondv(CO,vv,(LIST)BDY(t));
10025: } else {
10026: c = (pointer)ptondv(CO,vv,(P)BDY(t));
10027: }
10028: if ( ishomo )
10029: ishomo = ishomo && ndv_ishomo(c);
10030: if ( c ) {
10031: NEXTNODE(fd0,fd); BDY(fd) = (pointer)ndv_dup(0,c);
10032: ndv_mod(-2,c);
10033: NEXTNODE(in0,in); BDY(in) = (pointer)c;
10034: }
10035: }
10036: if ( in0 ) NEXT(in) = 0;
10037: if ( fd0 ) NEXT(fd) = 0;
10038: if ( !ishomo && homo ) {
10039: for ( t = in0, wmax = max; t; t = NEXT(t) ) {
10040: c = (NDV)BDY(t); len = LEN(c);
10041: for ( a = BDY(c), i = 0; i < len; i++, NMV_ADV(a) )
10042: wmax = MAX(TD(DL(a)),wmax);
10043: }
10044: homogenize_order(ord,nvar,&ord1);
10045: nd_init_ord(ord1);
10046: nd_setup_parameters(nvar+1,wmax);
10047: for ( t = fd0; t; t = NEXT(t) )
10048: ndv_homogenize((NDV)BDY(t),obpe,oadv,oepos,ompos);
10049: }
10050: if ( MaxDeg > 0 ) nocheck = 1;
1.24 noro 10051: ret = ndv_setup(-2,m,fd0,nd_gbblock?1:0,0,0);
1.1 noro 10052: if ( ret )
10053: cand = nd_f4_lf_trace_main(m,&perm);
10054: if ( !ret || !cand ) {
10055: *rp = 0; return;
10056: }
10057: if ( !ishomo && homo ) {
10058: /* dehomogenization */
10059: for ( t = cand; t; t = NEXT(t) ) ndv_dehomogenize((NDV)BDY(t),ord);
10060: nd_init_ord(ord);
10061: nd_setup_parameters(nvar,0);
10062: }
10063: cand = ndv_reducebase(cand,perm);
10064: cand = ndv_reduceall(-2,cand);
10065: cbpe = nd_bpe;
10066: get_eg(&eg0);
10067: if ( (ret = ndv_check_membership(-2,in0,obpe,oadv,oepos,cand)) != 0 ) {
10068: /* gbcheck : cand is a GB of Id(cand) ? */
10069: retn = nd_f4(-2,0,0);
10070: }
10071: if ( !retn ) {
10072: /* failure */
10073: *rp = 0; return;
10074: }
10075: get_eg(&eg1); init_eg(&eg_check); add_eg(&eg_check,&eg0,&eg1);
10076: if ( DP_Print )
1.5 noro 10077: fprintf(asir_out,"check=%.3fsec\n",eg_check.exectime);
1.1 noro 10078: /* dp->p */
10079: nd_bpe = cbpe;
10080: nd_setup_parameters(nd_nvar,0);
10081: for ( r = cand; r; r = NEXT(r) ) {
10082: if ( nd_module ) BDY(r) = ndvtopl(-2,CO,vv,BDY(r),mrank);
10083: else BDY(r) = (pointer)ndvtop(-2,CO,vv,BDY(r));
10084: }
10085: MKLIST(*rp,cand);
10086: }
10087:
10088: NODE nd_f4_lf_trace_main(int m,int **indp)
10089: {
10090: int i,nh,stat,index;
10091: NODE r,rm,g;
10092: ND_pairs d,l,l0,t;
10093: ND spol,red;
10094: NDV nf,redv,nfqv,nfv;
10095: NM s0,s;
10096: NODE rp0,srp0,nflist,nflist_lf;
10097: int nsp,nred,col,rank,len,k,j,a;
10098: UINT c;
10099: UINT **spmat;
10100: UINT *s0vect,*svect,*p,*v;
10101: int *colstat;
10102: IndArray *imat;
10103: int *rhead;
10104: int spcol,sprow;
10105: int sugar;
10106: PGeoBucket bucket;
10107: struct oEGT eg0,eg1,eg_f4;
10108:
10109: g = 0; d = 0;
10110: for ( i = 0; i < nd_psn; i++ ) {
10111: d = update_pairs(d,g,i,0);
10112: g = update_base(g,i);
10113: }
10114: while ( d ) {
10115: get_eg(&eg0);
10116: l = nd_minsugarp(d,&d);
10117: sugar = SG(l);
10118: if ( MaxDeg > 0 && sugar > MaxDeg ) break;
10119: bucket = create_pbucket();
10120: stat = nd_sp_f4(m,0,l,bucket);
10121: if ( !stat ) {
10122: for ( t = l; NEXT(t); t = NEXT(t) );
10123: NEXT(t) = d; d = l;
10124: d = nd_reconstruct(1,d);
10125: continue;
10126: }
10127: if ( bucket->m < 0 ) continue;
10128: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
10129: if ( !col ) {
10130: for ( t = l; NEXT(t); t = NEXT(t) );
10131: NEXT(t) = d; d = l;
10132: d = nd_reconstruct(1,d);
10133: continue;
10134: }
10135: get_eg(&eg1); init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg1);
10136: if ( DP_Print )
1.5 noro 10137: fprintf(asir_out,"\nsugar=%d,symb=%.3fsec,",sugar,eg_f4.exectime);
1.1 noro 10138: nflist = nd_f4_red(m,l,0,s0vect,col,rp0,&l0);
10139: if ( !l0 ) continue;
10140: l = l0;
10141:
10142: /* over LF */
10143: bucket = create_pbucket();
10144: stat = nd_sp_f4(-2,1,l,bucket);
10145: if ( !stat ) {
10146: for ( t = l; NEXT(t); t = NEXT(t) );
10147: NEXT(t) = d; d = l;
10148: d = nd_reconstruct(1,d);
10149: continue;
10150: }
10151: if ( bucket->m < 0 ) continue;
10152: col = nd_symbolic_preproc(bucket,1,&s0vect,&rp0);
10153: if ( !col ) {
10154: for ( t = l; NEXT(t); t = NEXT(t) );
10155: NEXT(t) = d; d = l;
10156: d = nd_reconstruct(1,d);
10157: continue;
10158: }
10159: nflist_lf = nd_f4_red(-2,l,1,s0vect,col,rp0,0);
10160: /* adding new bases */
10161: for ( rm = nflist, r = nflist_lf; r && rm; rm = NEXT(rm), r = NEXT(r) ) {
10162: nfv = (NDV)BDY(rm);
10163: nfqv = (NDV)BDY(r);
10164: if ( DL_COMPARE(HDL(nfv),HDL(nfqv)) ) return 0;
10165: ndv_removecont(m,nfv);
10166: ndv_removecont(-2,nfqv);
1.24 noro 10167: nh = ndv_newps(-2,nfv,nfqv);
1.1 noro 10168: d = update_pairs(d,g,nh,0);
10169: g = update_base(g,nh);
10170: }
10171: if ( r || rm ) return 0;
10172: }
10173: conv_ilist(nd_demand,1,g,indp);
10174: return g;
10175: }
10176:
1.7 noro 10177: #if SIZEOF_LONG==8
10178:
10179: NDV vect64_to_ndv(mp_limb_t *vect,int spcol,int col,int *rhead,UINT *s0vect)
10180: {
10181: int j,k,len;
10182: UINT *p;
10183: UINT c;
10184: NDV r;
10185: NMV mr0,mr;
10186:
10187: for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++;
10188: if ( !len ) return 0;
10189: else {
10190: mr0 = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
10191: #if 0
10192: ndv_alloc += nmv_adv*len;
10193: #endif
10194: mr = mr0;
10195: p = s0vect;
10196: for ( j = k = 0; j < col; j++, p += nd_wpd )
10197: if ( !rhead[j] ) {
10198: if ( (c = (UINT)vect[k++]) != 0 ) {
10199: ndl_copy(p,DL(mr)); CM(mr) = c; NMV_ADV(mr);
10200: }
10201: }
10202: MKNDV(nd_nvar,mr0,len,r);
10203: return r;
10204: }
10205: }
10206:
1.28 noro 10207: NDV vect64_to_ndv_s(mp_limb_t *vect,int col,UINT *s0vect)
10208: {
10209: int j,k,len;
10210: UINT *p;
10211: UINT c;
10212: NDV r;
10213: NMV mr0,mr;
10214:
10215: for ( j = 0, len = 0; j < col; j++ ) if ( vect[j] ) len++;
10216: if ( !len ) return 0;
10217: else {
10218: mr0 = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
10219: mr = mr0;
10220: p = s0vect;
10221: for ( j = k = 0; j < col; j++, p += nd_wpd )
10222: if ( (c = (UINT)vect[k++]) != 0 ) {
10223: ndl_copy(p,DL(mr)); CM(mr) = c; NMV_ADV(mr);
10224: }
10225: MKNDV(nd_nvar,mr0,len,r);
10226: return r;
10227: }
10228: }
10229:
1.7 noro 10230: int nd_to_vect64(int mod,UINT *s0,int n,ND d,mp_limb_t *r)
10231: {
10232: NM m;
1.11 noro 10233: UINT *t,*s,*u;
10234: int i,st,ed,md,prev,c;
1.7 noro 10235:
10236: for ( i = 0; i < n; i++ ) r[i] = 0;
1.11 noro 10237: prev = 0;
10238: for ( i = 0, m = BDY(d); m; m = NEXT(m) ) {
10239: t = DL(m);
10240: st = prev;
10241: ed = n;
10242: while ( ed > st ) {
10243: md = (st+ed)/2;
10244: u = s0+md*nd_wpd;
10245: c = DL_COMPARE(u,t);
10246: if ( c == 0 ) break;
10247: else if ( c > 0 ) st = md;
10248: else ed = md;
10249: }
10250: r[md] = (mp_limb_t)CM(m);
10251: prev = md;
1.7 noro 10252: }
10253: for ( i = 0; !r[i]; i++ );
10254: return i;
10255: }
10256:
10257: #define MOD128(a,c,m) ((a)=(((c)!=0||((a)>=(m)))?(((((U128)(c))<<64)+(a))%(m)):(a)))
10258:
1.28 noro 10259: int ndv_reduce_vect64(int m,mp_limb_t *svect,mp_limb_t *cvect,int col,IndArray *imat,NM_ind_pair *rp0,int nred,SIG sig)
1.7 noro 10260: {
10261: int i,j,k,len,pos,prev;
10262: mp_limb_t a,c,c1,c2;
10263: IndArray ivect;
10264: unsigned char *ivc;
10265: unsigned short *ivs;
10266: unsigned int *ivi;
10267: NDV redv;
10268: NMV mr;
10269: NODE rp;
10270: int maxrs;
10271:
10272: for ( i = 0; i < col; i++ ) cvect[i] = 0;
10273: maxrs = 0;
10274: for ( i = 0; i < nred; i++ ) {
10275: ivect = imat[i];
10276: k = ivect->head;
10277: a = svect[k]; c = cvect[k];
10278: MOD128(a,c,m);
10279: svect[k] = a; cvect[k] = 0;
1.28 noro 10280: if ( (c = svect[k]) != 0 && (sig == 0 || comp_sig(sig,rp0[i]->sig) > 0 ) ) {
1.11 noro 10281: Nf4_red++;
1.7 noro 10282: maxrs = MAX(maxrs,rp0[i]->sugar);
10283: c = m-c; redv = nd_ps[rp0[i]->index];
10284: len = LEN(redv); mr = BDY(redv);
10285: svect[k] = 0; prev = k;
10286: switch ( ivect->width ) {
10287: case 1:
10288: ivc = ivect->index.c;
10289: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
10290: pos = prev+ivc[j]; c1 = CM(mr); prev = pos;
1.12 noro 10291: c2 = svect[pos]+c1*c;
10292: if ( c2 < svect[pos] ) cvect[pos]++;
10293: svect[pos] = c2;
1.7 noro 10294: }
10295: break;
10296: case 2:
10297: ivs = ivect->index.s;
10298: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
10299: pos = prev+ivs[j]; c1 = CM(mr); prev = pos;
1.12 noro 10300: c2 = svect[pos]+c1*c;
10301: if ( c2 < svect[pos] ) cvect[pos]++;
10302: svect[pos] = c2;
1.7 noro 10303: }
10304: break;
10305: case 4:
10306: ivi = ivect->index.i;
10307: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
10308: pos = prev+ivi[j]; c1 = CM(mr); prev = pos;
1.12 noro 10309: c2 = svect[pos]+c1*c;
10310: if ( c2 < svect[pos] ) cvect[pos]++;
10311: svect[pos] = c2;
1.7 noro 10312: }
10313: break;
10314: }
10315: }
10316: }
10317: for ( i = 0; i < col; i++ ) {
10318: a = svect[i]; c = cvect[i]; MOD128(a,c,m); svect[i] = a;
10319: }
10320: return maxrs;
10321: }
10322:
10323: /* for Fp, 2^15=<p<2^29 */
10324:
10325: NODE nd_f4_red_mod64_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
10326: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz)
10327: {
10328: int spcol,sprow,a;
10329: int i,j,k,l,rank;
10330: NODE r0,r;
10331: ND_pairs sp;
10332: ND spol;
10333: mp_limb_t **spmat;
10334: mp_limb_t *svect,*cvect;
10335: mp_limb_t *v;
10336: int *colstat;
10337: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
10338: int maxrs;
10339: int *spsugar;
10340: ND_pairs *spactive;
10341:
10342: spcol = col-nred;
10343: get_eg(&eg0);
10344: /* elimination (1st step) */
10345: spmat = (mp_limb_t **)MALLOC(nsp*sizeof(mp_limb_t *));
10346: svect = (mp_limb_t *)MALLOC(col*sizeof(mp_limb_t));
10347: cvect = (mp_limb_t *)MALLOC(col*sizeof(mp_limb_t));
10348: spsugar = (int *)MALLOC(nsp*sizeof(int));
10349: spactive = !nz?0:(ND_pairs *)MALLOC(nsp*sizeof(ND_pairs));
10350: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
10351: nd_sp(m,0,sp,&spol);
10352: if ( !spol ) continue;
10353: nd_to_vect64(m,s0vect,col,spol,svect);
1.28 noro 10354: maxrs = ndv_reduce_vect64(m,svect,cvect,col,imat,rvect,nred,0);
1.7 noro 10355: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
10356: if ( i < col ) {
10357: spmat[sprow] = v = (mp_limb_t *)MALLOC_ATOMIC(spcol*sizeof(mp_limb_t));
10358: for ( j = k = 0; j < col; j++ )
10359: if ( !rhead[j] ) v[k++] = (UINT)svect[j];
10360: spsugar[sprow] = MAX(maxrs,SG(spol));
10361: if ( nz )
10362: spactive[sprow] = sp;
10363: sprow++;
10364: }
10365: nd_free(spol);
10366: }
1.12 noro 10367: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1); add_eg(&f4_elim1,&eg0,&eg1);
1.7 noro 10368: if ( DP_Print ) {
10369: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
10370: fflush(asir_out);
10371: }
10372: /* free index arrays */
10373: for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c);
10374:
10375: /* elimination (2nd step) */
10376: colstat = (int *)MALLOC(spcol*sizeof(int));
10377: rank = nd_gauss_elim_mod64(spmat,spsugar,spactive,sprow,spcol,m,colstat);
10378: r0 = 0;
10379: for ( i = 0; i < rank; i++ ) {
10380: NEXTNODE(r0,r); BDY(r) =
10381: (pointer)vect64_to_ndv(spmat[i],spcol,col,rhead,s0vect);
10382: SG((NDV)BDY(r)) = spsugar[i];
10383: GCFREE(spmat[i]);
10384: }
10385: if ( r0 ) NEXT(r) = 0;
10386:
10387: for ( ; i < sprow; i++ ) GCFREE(spmat[i]);
1.12 noro 10388: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2); add_eg(&f4_elim2,&eg1,&eg2);
1.7 noro 10389: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
10390: if ( DP_Print ) {
10391: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
10392: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
10393: nsp,nred,sprow,spcol,rank);
10394: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
10395: }
10396: if ( nz ) {
10397: for ( i = 0; i < rank-1; i++ ) NEXT(spactive[i]) = spactive[i+1];
10398: if ( rank > 0 ) {
10399: NEXT(spactive[rank-1]) = 0;
10400: *nz = spactive[0];
10401: } else
10402: *nz = 0;
10403: }
10404: return r0;
10405: }
10406:
10407: int nd_gauss_elim_mod64(mp_limb_t **mat,int *sugar,ND_pairs *spactive,int row,int col,int md,int *colstat)
10408: {
10409: int i,j,k,l,rank,s;
10410: mp_limb_t inv;
10411: mp_limb_t a;
10412: UINT c;
10413: mp_limb_t *t,*pivot,*pk;
10414: UINT *ck;
10415: UINT **cmat;
10416: UINT *ct;
10417: ND_pairs pair;
10418:
10419: cmat = (UINT **)MALLOC(row*sizeof(UINT *));
10420: for ( i = 0; i < row; i++ ) {
10421: cmat[i] = MALLOC_ATOMIC(col*sizeof(UINT));
10422: bzero(cmat[i],col*sizeof(UINT));
10423: }
10424:
10425: for ( rank = 0, j = 0; j < col; j++ ) {
10426: for ( i = rank; i < row; i++ ) {
10427: a = mat[i][j]; c = cmat[i][j];
10428: MOD128(a,c,md);
10429: mat[i][j] = a; cmat[i][j] = 0;
10430: }
10431: for ( i = rank; i < row; i++ )
10432: if ( mat[i][j] )
10433: break;
10434: if ( i == row ) {
10435: colstat[j] = 0;
10436: continue;
10437: } else
10438: colstat[j] = 1;
10439: if ( i != rank ) {
10440: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
10441: ct = cmat[i]; cmat[i] = cmat[rank]; cmat[rank] = ct;
10442: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
10443: if ( spactive ) {
10444: pair = spactive[i]; spactive[i] = spactive[rank];
10445: spactive[rank] = pair;
10446: }
10447: }
10448: /* column j is normalized */
10449: s = sugar[rank];
10450: inv = invm((UINT)mat[rank][j],md);
10451: /* normalize pivot row */
10452: for ( k = j, pk = mat[rank]+j, ck = cmat[rank]+j; k < col; k++, pk++, ck++ ) {
10453: a = *pk; c = *ck; MOD128(a,c,md); *pk = (a*inv)%md; *ck = 0;
10454: }
10455: for ( i = rank+1; i < row; i++ ) {
10456: if ( (a = mat[i][j]) != 0 ) {
10457: sugar[i] = MAX(sugar[i],s);
10458: red_by_vect64(md,mat[i]+j,cmat[i]+j,mat[rank]+j,(int)(md-a),col-j);
1.11 noro 10459: Nf4_red++;
1.7 noro 10460: }
10461: }
10462: rank++;
10463: }
10464: for ( j = col-1, l = rank-1; j >= 0; j-- )
10465: if ( colstat[j] ) {
10466: for ( k = j, pk = mat[l]+j, ck = cmat[l]+j; k < col; k++, pk++, ck++ ) {
10467: a = *pk; c = *ck; MOD128(a,c,md); *pk = a; *ck = 0;
10468: }
10469: s = sugar[l];
10470: for ( i = 0; i < l; i++ ) {
10471: a = mat[i][j]; c = cmat[i][j]; MOD128(a,c,md); mat[i][j] = a; cmat[i][j] = 0;
10472: if ( a ) {
10473: sugar[i] = MAX(sugar[i],s);
10474: red_by_vect64(md,mat[i]+j,cmat[i]+j,mat[l]+j,(int)(md-a),col-j);
1.11 noro 10475: Nf4_red++;
1.7 noro 10476: }
10477: }
10478: l--;
10479: }
10480: for ( i = 0; i < row; i++ ) GCFREE(cmat[i]);
10481: GCFREE(cmat);
10482: return rank;
10483: }
10484: #endif
10485:
1.28 noro 10486: int nd_gauss_elim_mod64_s(mp_limb_t **mat,int *sugar,ND_pairs *spactive,int row,int col,int md,int *colstat,SIG *sig)
10487: {
10488: int i,j,k,l,rank,s,imin;
10489: mp_limb_t inv;
10490: mp_limb_t a;
10491: UINT c;
10492: mp_limb_t *t,*pivot,*pk;
10493: UINT *ck;
10494: UINT **cmat;
10495: UINT *ct;
10496: ND_pairs pair;
10497: SIG sg;
10498:
10499: cmat = (UINT **)MALLOC(row*sizeof(UINT *));
10500: for ( i = 0; i < row; i++ ) {
10501: cmat[i] = MALLOC_ATOMIC(col*sizeof(UINT));
10502: bzero(cmat[i],col*sizeof(UINT));
10503: }
10504:
10505: for ( rank = 0, j = 0; j < col; j++ ) {
10506: for ( i = rank; i < row; i++ ) {
10507: a = mat[i][j]; c = cmat[i][j];
10508: MOD128(a,c,md);
10509: mat[i][j] = a; cmat[i][j] = 0;
10510: }
10511: imin = -1;
10512: for ( i = rank; i < row; i++ )
10513: if ( mat[i][j] && (imin < 0 || comp_sig(sig[imin],sig[i]) > 0) ) imin = i;
10514: if ( imin == -1 ) {
10515: colstat[j] = 0;
10516: continue;
10517: } else
10518: colstat[j] = 1;
10519: if ( imin != rank ) {
10520: t = mat[imin]; mat[imin] = mat[rank]; mat[rank] = t;
10521: ct = cmat[imin]; cmat[imin] = cmat[rank]; cmat[rank] = ct;
10522: s = sugar[imin]; sugar[imin] = sugar[rank]; sugar[rank] = s;
10523: sg = sig[imin]; sig[imin] = sig[rank]; sig[rank] = sg;
10524: if ( spactive ) {
10525: pair = spactive[imin]; spactive[imin] = spactive[rank];
10526: spactive[rank] = pair;
10527: }
10528: }
10529: /* column j is normalized */
10530: s = sugar[rank];
10531: inv = invm((UINT)mat[rank][j],md);
10532: /* normalize pivot row */
10533: for ( k = j, pk = mat[rank]+j, ck = cmat[rank]+j; k < col; k++, pk++, ck++ ) {
10534: a = *pk; c = *ck; MOD128(a,c,md); *pk = (a*inv)%md; *ck = 0;
10535: }
10536: for ( i = rank+1; i < row; i++ ) {
10537: if ( (a = mat[i][j]) != 0 ) {
10538: sugar[i] = MAX(sugar[i],s);
10539: red_by_vect64(md,mat[i]+j,cmat[i]+j,mat[rank]+j,(int)(md-a),col-j);
10540: Nf4_red++;
10541: }
10542: }
10543: rank++;
10544: }
10545: #if 1
10546: for ( j = col-1, l = rank-1; j >= 0; j-- )
10547: if ( colstat[j] ) {
10548: for ( k = j, pk = mat[l]+j, ck = cmat[l]+j; k < col; k++, pk++, ck++ ) {
10549: a = *pk; c = *ck; MOD128(a,c,md); *pk = a; *ck = 0;
10550: }
10551: s = sugar[l];
10552: for ( i = 0; i < l; i++ ) {
10553: a = mat[i][j]; c = cmat[i][j]; MOD128(a,c,md); mat[i][j] = a; cmat[i][j] = 0;
10554: if ( a && comp_sig(sig[i],sig[l]) > 0 ) {
10555: sugar[i] = MAX(sugar[i],s);
10556: red_by_vect64(md,mat[i]+j,cmat[i]+j,mat[l]+j,(int)(md-a),col-j);
10557: Nf4_red++;
10558: }
10559: }
10560: l--;
10561: }
10562: #endif
10563: for ( i = 0; i < row; i++ ) GCFREE(cmat[i]);
10564: GCFREE(cmat);
10565: return rank;
10566: }
10567:
10568: NODE nd_f4_red_mod64_main_s(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
10569: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,NODE *syzlistp)
10570: {
10571: int spcol,sprow,a;
10572: int i,j,k,l,rank;
10573: NODE r0,r;
10574: ND_pairs sp;
10575: ND spol;
10576: mp_limb_t **spmat;
10577: mp_limb_t *svect,*cvect;
10578: mp_limb_t *v;
10579: int *colstat;
10580: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
10581: int maxrs;
10582: int *spsugar;
10583: ND_pairs *spactive;
10584: SIG *spsig;
10585:
10586: get_eg(&eg0);
10587: /* elimination (1st step) */
10588: spmat = (mp_limb_t **)MALLOC(nsp*sizeof(mp_limb_t *));
10589: cvect = (mp_limb_t *)MALLOC(col*sizeof(mp_limb_t));
10590: spsugar = (int *)MALLOC(nsp*sizeof(int));
10591: spsig = (SIG *)MALLOC(nsp*sizeof(SIG));
10592: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
10593: nd_sp(m,0,sp,&spol);
10594: if ( !spol ) {
1.29 ! noro 10595: syzlistp[sp->sig->pos] = insert_sig(syzlistp[sp->sig->pos],sp->sig);
1.28 noro 10596: continue;
10597: }
10598: svect = (mp_limb_t *)MALLOC(col*sizeof(mp_limb_t));
10599: nd_to_vect64(m,s0vect,col,spol,svect);
10600: maxrs = ndv_reduce_vect64(m,svect,cvect,col,imat,rvect,nred,spol->sig);
10601: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
10602: if ( i < col ) {
10603: spmat[sprow] = svect;
10604: spsugar[sprow] = MAX(maxrs,SG(spol));
10605: spsig[sprow] = sp->sig;
10606: sprow++;
10607: } else {
1.29 ! noro 10608: syzlistp[sp->sig->pos] = insert_sig(syzlistp[sp->sig->pos],sp->sig);
1.28 noro 10609: }
10610: nd_free(spol);
10611: }
10612: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1); add_eg(&f4_elim1,&eg0,&eg1);
10613: if ( DP_Print ) {
10614: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
10615: fflush(asir_out);
10616: }
10617: /* free index arrays */
10618: for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c);
10619:
10620: /* elimination (2nd step) */
10621: colstat = (int *)MALLOC(col*sizeof(int));
10622: rank = nd_gauss_elim_mod64_s(spmat,spsugar,0,sprow,col,m,colstat,spsig);
10623: r0 = 0;
10624: for ( i = 0; i < rank; i++ ) {
10625: NEXTNODE(r0,r);
10626: BDY(r) = vect64_to_ndv_s(spmat[i],col,s0vect);
10627: SG((NDV)BDY(r)) = spsugar[i];
10628: ((NDV)BDY(r))->sig = spsig[i];
10629: GCFREE(spmat[i]);
10630: }
10631: if ( r0 ) NEXT(r) = 0;
10632:
10633: for ( ; i < sprow; i++ ) {
10634: GCFREE(spmat[i]);
1.29 ! noro 10635: syzlistp[spsig[i]->pos] = insert_sig(syzlistp[spsig[i]->pos],spsig[i]);
1.28 noro 10636: }
10637: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2); add_eg(&f4_elim2,&eg1,&eg2);
10638: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
10639: if ( DP_Print ) {
10640: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
10641: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
10642: nsp,nred,sprow,col,rank);
10643: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
10644: }
10645: return r0;
10646: }
10647:
10648: NODE nd_f4_red_s(int m,ND_pairs sp0,int trace,UINT *s0vect,int col,NODE rp0,NODE *syzlistp)
10649: {
10650: IndArray *imat;
10651: int nsp,nred,i,start;
10652: int *rhead;
10653: NODE r0,rp;
10654: ND_pairs sp;
10655: NM_ind_pair *rvect;
10656: UINT *s;
10657: int *s0hash;
10658: struct oEGT eg0,eg1,eg_conv;
10659:
10660: for ( sp = sp0, nsp = 0; sp; sp = NEXT(sp), nsp++ );
10661: nred = length(rp0);
10662: imat = (IndArray *)MALLOC(nred*sizeof(IndArray));
10663: rhead = (int *)MALLOC(col*sizeof(int));
10664: for ( i = 0; i < col; i++ ) rhead[i] = 0;
10665:
10666: /* construction of index arrays */
10667: get_eg(&eg0);
10668: if ( DP_Print ) {
10669: fprintf(asir_out,"%dx%d,",nsp+nred,col);
10670: fflush(asir_out);
10671: }
10672: rvect = (NM_ind_pair *)MALLOC(nred*sizeof(NM_ind_pair));
10673: for ( start = 0, rp = rp0, i = 0; rp; i++, rp = NEXT(rp) ) {
10674: rvect[i] = (NM_ind_pair)BDY(rp);
10675: imat[i] = nm_ind_pair_to_vect_compress(trace,s0vect,col,rvect[i],start);
10676: rhead[imat[i]->head] = 1;
10677: start = imat[i]->head;
10678: }
10679: get_eg(&eg1); init_eg(&eg_conv); add_eg(&eg_conv,&eg0,&eg1); add_eg(&f4_conv,&eg0,&eg1);
10680: if ( DP_Print ) {
10681: fprintf(asir_out,"conv=%.3fsec,",eg_conv.exectime);
10682: fflush(asir_out);
10683: }
10684: if ( m > 0 )
10685: r0 = nd_f4_red_mod64_main_s(m,sp0,nsp,s0vect,col,rvect,rhead,imat,nred,syzlistp);
10686: else
10687: // r0 = nd_f4_red_q_main_s(sp0,nsp,trace,s0vect,col,rvect,rhead,imat,nred);
10688: error("nd_f4_red_q_main_s : not implemented yet");
10689: return r0;
10690: }
10691:
10692: INLINE int ndl_find_reducer_minsig(UINT *dg)
10693: {
10694: RHist r;
10695: int i,singular,ret,d,k,imin;
10696: SIG t;
10697: static int wpd,nvar;
10698: static SIG quo,quomin;
10699: static UINT *tmp;
10700:
10701: if ( !quo || nvar != nd_nvar ) { NEWSIG(quo); NEWSIG(quomin); }
10702: if ( wpd != nd_wpd ) {
10703: wpd = nd_wpd;
10704: tmp = (UINT *)MALLOC(wpd*sizeof(UINT));
10705: }
10706: #if 0
10707: d = ndl_hash_value(dg);
10708: for ( r = nd_red[d], k = 0; r; r = NEXT(r), k++ ) {
10709: if ( ndl_equal(dg,DL(r)) ) {
10710: return r->index;
10711: }
10712: }
10713: #endif
10714: imin = -1;
10715: for ( i = 0; i < nd_psn; i++ ) {
10716: r = nd_psh[i];
10717: if ( ndl_reducible(dg,DL(r)) ) {
10718: ndl_sub(dg,DL(r),tmp);
10719: _ndltodl(tmp,DL(quo));
10720: _addtodl(nd_nvar,DL(nd_psh[i]->sig),DL(quo));
10721: quo->pos = nd_psh[i]->sig->pos;
10722: if ( imin < 0 || comp_sig(quomin,quo) > 0 ) {
10723: t = quo; quo = quomin; quomin = t;
10724: imin = i;
10725: }
10726: }
10727: }
10728: if ( imin == -1 ) return nd_psn;
10729: else {
10730: #if 0
10731: nd_append_red(dg,i);
10732: #endif
10733: return imin;
10734: }
10735: }
10736:
10737: int nd_symbolic_preproc_s(PGeoBucket bucket,int trace,UINT **s0vect,NODE *r)
10738: {
10739: NODE rp0,rp;
10740: NM mul,head,s0,s;
10741: int index,col,i,sugar;
10742: RHist h;
10743: UINT *s0v,*p;
10744: NM_ind_pair pair;
10745: ND red;
10746: NDV *ps;
10747: SIG sig;
10748:
10749: s0 = 0; rp0 = 0; col = 0;
10750: if ( nd_demand )
10751: ps = trace?nd_ps_trace_sym:nd_ps_sym;
10752: else
10753: ps = trace?nd_ps_trace:nd_ps;
10754: while ( 1 ) {
10755: head = remove_head_pbucket_symbolic(bucket);
10756: if ( !head ) break;
10757: if ( !s0 ) s0 = head;
10758: else NEXT(s) = head;
10759: s = head;
10760: index = ndl_find_reducer_minsig(DL(head));
10761: if ( index >= 0 && index < nd_psn ) {
10762: h = nd_psh[index];
10763: NEWNM(mul);
10764: ndl_sub(DL(head),DL(h),DL(mul));
10765: if ( ndl_check_bound2(index,DL(mul)) )
10766: return 0;
10767: sugar = TD(DL(mul))+SG(ps[index]);
10768: NEWSIG(sig);
10769: _ndltodl(DL(mul),DL(sig));
10770: _addtodl(nd_nvar,DL(nd_psh[index]->sig),DL(sig));
10771: sig->pos = nd_psh[index]->sig->pos;
10772: MKNM_ind_pair(pair,mul,index,sugar,sig);
10773: red = ndv_mul_nm_symbolic(mul,ps[index]);
10774: add_pbucket_symbolic(bucket,nd_remove_head(red));
10775: NEXTNODE(rp0,rp); BDY(rp) = (pointer)pair;
10776: }
10777: col++;
10778: }
10779: if ( rp0 ) NEXT(rp) = 0;
10780: NEXT(s) = 0;
10781: s0v = (UINT *)MALLOC_ATOMIC(col*nd_wpd*sizeof(UINT));
10782: for ( i = 0, p = s0v, s = s0; i < col;
10783: i++, p += nd_wpd, s = NEXT(s) ) ndl_copy(DL(s),p);
10784: *s0vect = s0v;
10785: *r = rp0;
10786:
10787: return col;
10788: }
10789:
10790: NODE nd_sba_f4(int m,int **indp)
10791: {
10792: int i,nh,stat,index,f4red;
10793: NODE r,g,tn0,tn,node;
10794: ND_pairs d,l,t,ll0,ll,lh;
10795: LIST l0,l1;
10796: ND spol,red;
10797: NDV nf,redv;
10798: NM s0,s;
10799: NODE rp0,srp0,nflist;
10800: int nsp,nred,col,rank,len,k,j,a,i1s,i2s;
10801: UINT c;
10802: UINT **spmat;
10803: UINT *s0vect,*svect,*p,*v;
10804: int *colstat;
10805: IndArray *imat;
10806: int *rhead;
10807: int spcol,sprow;
10808: int sugar,sugarh;
10809: PGeoBucket bucket;
10810: struct oEGT eg0,eg1,eg_f4;
10811: Z i1,i2,sugarq;
1.29 ! noro 10812: NODE *syzlist;
1.28 noro 10813:
10814: Nf4_red=0;
10815: g = 0; d = 0;
1.29 ! noro 10816: syzlist = (NODE *)MALLOC(nd_psn*sizeof(NODE));
1.28 noro 10817: for ( i = 0; i < nd_psn; i++ ) {
10818: d = update_pairs_s(d,g,i,syzlist);
10819: g = append_one(g,i);
10820: }
10821: f4red = 1;
10822: while ( d ) {
10823: l = nd_minsugarp_s(d,&d);
10824: if ( !l ) continue;
10825: sugar = nd_sugarweight?l->sugar2:SG(l);
10826: if ( MaxDeg > 0 && sugar > MaxDeg ) break;
10827: bucket = create_pbucket();
10828: stat = nd_sp_f4(m,0,l,bucket);
10829: if ( !stat ) {
10830: for ( t = l; NEXT(t); t = NEXT(t) );
10831: NEXT(t) = d; d = l;
10832: d = nd_reconstruct(0,d);
10833: continue;
10834: }
10835: if ( bucket->m < 0 ) continue;
10836: col = nd_symbolic_preproc_s(bucket,0,&s0vect,&rp0);
10837: if ( !col ) {
10838: for ( t = l; NEXT(t); t = NEXT(t) );
10839: NEXT(t) = d; d = l;
10840: d = nd_reconstruct(0,d);
10841: continue;
10842: }
10843: if ( DP_Print ) fprintf(asir_out,"sugar=%d,",sugar);
10844: l = remove_large_lcm(l);
1.29 ! noro 10845: nflist = nd_f4_red_s(m,l,0,s0vect,col,rp0,syzlist);
1.28 noro 10846: /* adding new bases */
10847: for ( r = nflist; r; r = NEXT(r) ) {
10848: ND tmp,tmpred;
10849: SIG sig;
10850:
10851: nf = (NDV)BDY(r);
10852: sig = nf->sig;
10853: tmp = ndvtond(m,nf);
10854: stat = nd_nf_s(m,0,tmp,nd_ps,!Top,&tmpred);
10855: if ( stat < 0 ) {
10856: // top reducible
10857: if ( DP_Print ) { fprintf(asir_out,"S"); fflush(asir_out); }
10858: } else if ( tmpred ) {
10859: nf = ndtondv(m,tmpred);
10860: ndv_removecont(m,nf);
10861: nh = ndv_newps(m,nf,0);
10862: d = update_pairs_s(d,g,nh,syzlist);
10863: g = append_one(g,nh);
10864: } else {
1.29 ! noro 10865: syzlist[sig->pos] = insert_sig(syzlist[sig->pos],sig);
1.28 noro 10866: }
10867: }
1.29 ! noro 10868: // YYY
! 10869: // for ( r = syzlist; r; r = NEXT(r) )
! 10870: // d = remove_spair_s(d,(SIG)BDY(r));
1.28 noro 10871: if ( DP_Print ) {
10872: fprintf(asir_out,"f4red=%d,gblen=%d\n",f4red,length(g)); fflush(asir_out);
10873: }
10874: f4red++;
10875: if ( nd_f4red && f4red > nd_f4red ) break;
10876: if ( nd_rank0 && !nflist ) break;
10877: }
10878: if ( DP_Print ) {
10879: fprintf(asir_out,"number of red=%d,",Nf4_red);
10880: }
10881: conv_ilist(nd_demand,0,g,indp);
10882: return g;
10883: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to nd.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2018 / engine