Annotation of OpenXM_contrib2/asir2018/engine/nd.c, Revision 1.25
1.25 ! noro 1: /* $OpenXM: OpenXM_contrib2/asir2018/engine/nd.c,v 1.24 2020/06/19 10:18:13 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;
21:
22: Obj nd_top_weight;
23:
24: static NODE nd_subst;
25: static VL nd_vc;
26: static int nd_ntrans;
27: static int nd_nalg;
28: #if 0
29: static int ndv_alloc;
30: #endif
31: #if 1
32: static int nd_f4_nsp=0x7fffffff;
33: #else
34: static int nd_f4_nsp=50;
35: #endif
36: static double nd_scale=2;
37: static UINT **nd_bound;
38: static struct order_spec *nd_ord;
39: static EPOS nd_epos;
40: static BlockMask nd_blockmask;
41: static int nd_nvar;
42: static int nd_isrlex;
43: static int nd_epw,nd_bpe,nd_wpd,nd_exporigin;
44: static UINT nd_mask[32];
45: static UINT nd_mask0,nd_mask1;
46:
47: static NDV *nd_ps;
48: static NDV *nd_ps_trace;
49: static NDV *nd_ps_sym;
50: static NDV *nd_ps_trace_sym;
51: static RHist *nd_psh;
52: static int nd_psn,nd_pslen;
53: static RHist *nd_red;
54: static int *nd_work_vector;
55: static int **nd_matrix;
56: static int nd_matrix_len;
57: static struct weight_or_block *nd_worb;
58: static int nd_worb_len;
59: static int nd_found,nd_create,nd_notfirst;
60: static int nmv_adv;
61: static int nd_demand;
1.21 noro 62: static int nd_module,nd_module_ordtype,nd_mpos,nd_pot_nelim;
1.1 noro 63: static int nd_module_rank,nd_poly_weight_len;
64: static int *nd_poly_weight,*nd_module_weight;
65: static NODE nd_tracelist;
66: static NODE nd_alltracelist;
67: static int nd_gentrace,nd_gensyz,nd_nora,nd_newelim,nd_intersect,nd_lf;
68: static int *nd_gbblock;
69: static NODE nd_nzlist,nd_check_splist;
70: static int nd_splist;
71: static int *nd_sugarweight;
72: static int nd_f4red,nd_rank0,nd_last_nonzero;
73:
74: NumberField get_numberfield();
75: UINT *nd_det_compute_bound(NDV **dm,int n,int j);
76: void nd_det_reconstruct(NDV **dm,int n,int j,NDV d);
77: void nd_heu_nezgcdnpz(VL vl,P *pl,int m,int full,P *pr);
78: int nd_monic(int m,ND *p);
79: NDV plain_vect_to_ndv_q(Z *mat,int col,UINT *s0vect);
80: LIST ndvtopl(int mod,VL vl,VL dvl,NDV p,int rank);
81: NDV pltondv(VL vl,VL dvl,LIST p);
82: void pltozpl(LIST l,Q *cont,LIST *pp);
83: void ndl_max(UINT *d1,unsigned *d2,UINT *d);
84: void nmtodp(int mod,NM m,DP *r);
1.15 noro 85: void ndltodp(UINT *d,DP *r);
1.1 noro 86: NODE reverse_node(NODE n);
87: P ndc_div(int mod,union oNDC a,union oNDC b);
88: P ndctop(int mod,union oNDC c);
89: void finalize_tracelist(int i,P cont);
90: void conv_ilist(int demand,int trace,NODE g,int **indp);
91: void parse_nd_option(NODE opt);
92: void dltondl(int n,DL dl,UINT *r);
93: DP ndvtodp(int mod,NDV p);
94: DP ndtodp(int mod,ND p);
1.16 noro 95: DPM ndvtodpm(int mod,NDV p);
96: NDV dpmtondv(int mod,DPM p);
97: int dpm_getdeg(DPM p,int *rank);
98: void dpm_ptozp(DPM p,Z *cont,DPM *r);
99: int compdmm(int nv,DMM a,DMM b);
1.1 noro 100:
101: void Pdp_set_weight(NODE,VECT *);
102: void Pox_cmo_rpc(NODE,Obj *);
103:
104: ND nd_add_lf(ND p1,ND p2);
105: void nd_mul_c_lf(ND p,Z mul);
106: void ndv_mul_c_lf(NDV p,Z mul);
107: NODE nd_f4_red_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
108: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz);
109: NODE nd_f4_red_mod64_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
110: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz);
111: NODE nd_f4_red_lf_main(int m,ND_pairs sp0,int nsp,int trace,UINT *s0vect,int col,
112: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred);
113: int nd_gauss_elim_lf(mpz_t **mat0,int *sugar,int row,int col,int *colstat);
114: NODE nd_f4_lf_trace_main(int m,int **indp);
115: void nd_f4_lf_trace(LIST f,LIST v,int trace,int homo,struct order_spec *ord,LIST *rp);
116:
117: extern int lf_lazy;
118: extern Z current_mod_lf;
119:
120: extern int Denominator,DP_Multiple,MaxDeg;
121:
122: #define BLEN (8*sizeof(unsigned long))
123:
124: typedef struct matrix {
125: int row,col;
126: unsigned long **a;
127: } *matrix;
128:
129:
130: void nd_free_private_storage()
131: {
132: _nm_free_list = 0;
133: _ndp_free_list = 0;
134: #if 0
135: GC_gcollect();
136: #endif
137: }
138:
139: void _NM_alloc()
140: {
141: NM p;
142: int i;
143:
144: for ( i = 0; i < 1024; i++ ) {
145: p = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
146: p->next = _nm_free_list; _nm_free_list = p;
147: }
148: }
149:
150: matrix alloc_matrix(int row,int col)
151: {
152: unsigned long **a;
153: int i,len,blen;
154: matrix mat;
155:
156: mat = (matrix)MALLOC(sizeof(struct matrix));
157: mat->row = row;
158: mat->col = col;
159: mat->a = a = (unsigned long **)MALLOC(row*sizeof(unsigned long *));
160: return mat;
161: }
162:
163:
164: void _ND_alloc()
165: {
166: ND p;
167: int i;
168:
169: for ( i = 0; i < 1024; i++ ) {
170: p = (ND)MALLOC(sizeof(struct oND));
171: p->body = (NM)_nd_free_list; _nd_free_list = p;
172: }
173: }
174:
175: void _NDP_alloc()
176: {
177: ND_pairs p;
178: int i;
179:
180: for ( i = 0; i < 1024; i++ ) {
181: p = (ND_pairs)MALLOC(sizeof(struct oND_pairs)
182: +(nd_wpd-1)*sizeof(UINT));
183: p->next = _ndp_free_list; _ndp_free_list = p;
184: }
185: }
186:
187: INLINE int nd_length(ND p)
188: {
189: NM m;
190: int i;
191:
192: if ( !p )
193: return 0;
194: else {
195: for ( i = 0, m = BDY(p); m; m = NEXT(m), i++ );
196: return i;
197: }
198: }
199:
200: extern int dp_negative_weight;
201:
202: INLINE int ndl_reducible(UINT *d1,UINT *d2)
203: {
204: UINT u1,u2;
205: int i,j;
206:
207: if ( nd_module && (MPOS(d1) != MPOS(d2)) ) return 0;
208:
209: if ( !dp_negative_weight && TD(d1) < TD(d2) ) return 0;
210: #if USE_UNROLL
211: switch ( nd_bpe ) {
212: case 3:
213: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
214: u1 = d1[i]; u2 = d2[i];
215: if ( (u1&0x38000000) < (u2&0x38000000) ) return 0;
216: if ( (u1& 0x7000000) < (u2& 0x7000000) ) return 0;
217: if ( (u1& 0xe00000) < (u2& 0xe00000) ) return 0;
218: if ( (u1& 0x1c0000) < (u2& 0x1c0000) ) return 0;
219: if ( (u1& 0x38000) < (u2& 0x38000) ) return 0;
220: if ( (u1& 0x7000) < (u2& 0x7000) ) return 0;
221: if ( (u1& 0xe00) < (u2& 0xe00) ) return 0;
222: if ( (u1& 0x1c0) < (u2& 0x1c0) ) return 0;
223: if ( (u1& 0x38) < (u2& 0x38) ) return 0;
224: if ( (u1& 0x7) < (u2& 0x7) ) return 0;
225: }
226: return 1;
227: break;
228: case 4:
229: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
230: u1 = d1[i]; u2 = d2[i];
231: if ( (u1&0xf0000000) < (u2&0xf0000000) ) return 0;
232: if ( (u1& 0xf000000) < (u2& 0xf000000) ) return 0;
233: if ( (u1& 0xf00000) < (u2& 0xf00000) ) return 0;
234: if ( (u1& 0xf0000) < (u2& 0xf0000) ) return 0;
235: if ( (u1& 0xf000) < (u2& 0xf000) ) return 0;
236: if ( (u1& 0xf00) < (u2& 0xf00) ) return 0;
237: if ( (u1& 0xf0) < (u2& 0xf0) ) return 0;
238: if ( (u1& 0xf) < (u2& 0xf) ) return 0;
239: }
240: return 1;
241: break;
242: case 6:
243: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
244: u1 = d1[i]; u2 = d2[i];
245: if ( (u1&0x3f000000) < (u2&0x3f000000) ) return 0;
246: if ( (u1& 0xfc0000) < (u2& 0xfc0000) ) return 0;
247: if ( (u1& 0x3f000) < (u2& 0x3f000) ) return 0;
248: if ( (u1& 0xfc0) < (u2& 0xfc0) ) return 0;
249: if ( (u1& 0x3f) < (u2& 0x3f) ) return 0;
250: }
251: return 1;
252: break;
253: case 8:
254: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
255: u1 = d1[i]; u2 = d2[i];
256: if ( (u1&0xff000000) < (u2&0xff000000) ) return 0;
257: if ( (u1& 0xff0000) < (u2& 0xff0000) ) return 0;
258: if ( (u1& 0xff00) < (u2& 0xff00) ) return 0;
259: if ( (u1& 0xff) < (u2& 0xff) ) return 0;
260: }
261: return 1;
262: break;
263: case 16:
264: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
265: u1 = d1[i]; u2 = d2[i];
266: if ( (u1&0xffff0000) < (u2&0xffff0000) ) return 0;
267: if ( (u1& 0xffff) < (u2& 0xffff) ) return 0;
268: }
269: return 1;
270: break;
271: case 32:
272: for ( i = nd_exporigin; i < nd_wpd; i++ )
273: if ( d1[i] < d2[i] ) return 0;
274: return 1;
275: break;
276: default:
277: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
278: u1 = d1[i]; u2 = d2[i];
279: for ( j = 0; j < nd_epw; j++ )
280: if ( (u1&nd_mask[j]) < (u2&nd_mask[j]) ) return 0;
281: }
282: return 1;
283: }
284: #else
285: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
286: u1 = d1[i]; u2 = d2[i];
287: for ( j = 0; j < nd_epw; j++ )
288: if ( (u1&nd_mask[j]) < (u2&nd_mask[j]) ) return 0;
289: }
290: return 1;
291: #endif
292: }
293:
1.24 noro 294: int ndl_reducible_s(UINT *d1,UINT *d2,UINT *quo)
295: {
296: UINT u1,u2;
297: int i,j;
298:
299: if ( nd_module && (MPOS(d1) != MPOS(d2)) ) return 0;
300:
301: if ( !dp_negative_weight && TD(d1) < TD(d2) ) return 0;
302: #if USE_UNROLL
303: switch ( nd_bpe ) {
304: case 3:
305: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
306: u1 = d1[i]; u2 = d2[i];
307: if ( (u1&0x38000000) < (u2&0x38000000) ) return 0;
308: if ( (u1& 0x7000000) < (u2& 0x7000000) ) return 0;
309: if ( (u1& 0xe00000) < (u2& 0xe00000) ) return 0;
310: if ( (u1& 0x1c0000) < (u2& 0x1c0000) ) return 0;
311: if ( (u1& 0x38000) < (u2& 0x38000) ) return 0;
312: if ( (u1& 0x7000) < (u2& 0x7000) ) return 0;
313: if ( (u1& 0xe00) < (u2& 0xe00) ) return 0;
314: if ( (u1& 0x1c0) < (u2& 0x1c0) ) return 0;
315: if ( (u1& 0x38) < (u2& 0x38) ) return 0;
316: if ( (u1& 0x7) < (u2& 0x7) ) return 0;
317: }
318: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
319: return 1;
320: break;
321: case 4:
322: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
323: u1 = d1[i]; u2 = d2[i];
324: if ( (u1&0xf0000000) < (u2&0xf0000000) ) return 0;
325: if ( (u1& 0xf000000) < (u2& 0xf000000) ) return 0;
326: if ( (u1& 0xf00000) < (u2& 0xf00000) ) return 0;
327: if ( (u1& 0xf0000) < (u2& 0xf0000) ) return 0;
328: if ( (u1& 0xf000) < (u2& 0xf000) ) return 0;
329: if ( (u1& 0xf00) < (u2& 0xf00) ) return 0;
330: if ( (u1& 0xf0) < (u2& 0xf0) ) return 0;
331: if ( (u1& 0xf) < (u2& 0xf) ) return 0;
332: }
333: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
334: return 1;
335: break;
336: case 6:
337: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
338: u1 = d1[i]; u2 = d2[i];
339: if ( (u1&0x3f000000) < (u2&0x3f000000) ) return 0;
340: if ( (u1& 0xfc0000) < (u2& 0xfc0000) ) return 0;
341: if ( (u1& 0x3f000) < (u2& 0x3f000) ) return 0;
342: if ( (u1& 0xfc0) < (u2& 0xfc0) ) return 0;
343: if ( (u1& 0x3f) < (u2& 0x3f) ) return 0;
344: }
345: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
346: return 1;
347: break;
348: case 8:
349: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
350: u1 = d1[i]; u2 = d2[i];
351: if ( (u1&0xff000000) < (u2&0xff000000) ) return 0;
352: if ( (u1& 0xff0000) < (u2& 0xff0000) ) return 0;
353: if ( (u1& 0xff00) < (u2& 0xff00) ) return 0;
354: if ( (u1& 0xff) < (u2& 0xff) ) return 0;
355: }
356: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
357: return 1;
358: break;
359: case 16:
360: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
361: u1 = d1[i]; u2 = d2[i];
362: if ( (u1&0xffff0000) < (u2&0xffff0000) ) return 0;
363: if ( (u1& 0xffff) < (u2& 0xffff) ) return 0;
364: }
365: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
366: return 1;
367: break;
368: case 32:
369: for ( i = nd_exporigin; i < nd_wpd; i++ )
370: if ( d1[i] < d2[i] ) return 0;
371: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
372: return 1;
373: break;
374: default:
375: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
376: u1 = d1[i]; u2 = d2[i];
377: for ( j = 0; j < nd_epw; j++ )
378: if ( (u1&nd_mask[j]) < (u2&nd_mask[j]) ) return 0;
379: }
380: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
381: return 1;
382: }
383: #else
384: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
385: u1 = d1[i]; u2 = d2[i];
386: for ( j = 0; j < nd_epw; j++ )
387: if ( (u1&nd_mask[j]) < (u2&nd_mask[j]) ) return 0;
388: }
389: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
390: return 1;
391: #endif
392: }
393:
1.1 noro 394: /*
395: * If the current order is a block order,
396: * then the last block is length 1 and contains
397: * the homo variable. Otherwise, the original
398: * order is either 0 or 2.
399: */
400:
401: void ndl_homogenize(UINT *d,UINT *r,int obpe,EPOS oepos,int ompos,int weight)
402: {
403: int w,i,e,n,omask0;
404:
405: omask0 = obpe==32?0xffffffff:((1<<obpe)-1);
406: n = nd_nvar-1;
407: ndl_zero(r);
408: for ( i = 0; i < n; i++ ) {
409: e = GET_EXP_OLD(d,i);
410: PUT_EXP(r,i,e);
411: }
412: w = TD(d);
413: PUT_EXP(r,nd_nvar-1,weight-w);
414: if ( nd_module ) MPOS(r) = d[ompos];
415: TD(r) = weight;
416: if ( nd_blockmask ) ndl_weight_mask(r);
417: }
418:
419: void ndl_dehomogenize(UINT *d)
420: {
421: UINT mask;
422: UINT h;
423: int i,bits;
424:
425: if ( nd_blockmask ) {
426: h = GET_EXP(d,nd_nvar-1);
427: XOR_EXP(d,nd_nvar-1,h);
428: TD(d) -= h;
429: ndl_weight_mask(d);
430: } else {
431: if ( nd_isrlex ) {
432: if ( nd_bpe == 32 ) {
433: h = d[nd_exporigin];
434: for ( i = nd_exporigin+1; i < nd_wpd; i++ )
435: d[i-1] = d[i];
436: d[i-1] = 0;
437: TD(d) -= h;
438: } else {
439: bits = nd_epw*nd_bpe;
440: mask = bits==32?0xffffffff:((1<<(nd_epw*nd_bpe))-1);
441: h = (d[nd_exporigin]>>((nd_epw-1)*nd_bpe))&nd_mask0;
442: for ( i = nd_exporigin; i < nd_wpd; i++ )
443: d[i] = ((d[i]<<nd_bpe)&mask)
444: |(i+1<nd_wpd?((d[i+1]>>((nd_epw-1)*nd_bpe))&nd_mask0):0);
445: TD(d) -= h;
446: }
447: } else {
448: h = GET_EXP(d,nd_nvar-1);
449: XOR_EXP(d,nd_nvar-1,h);
450: TD(d) -= h;
451: }
452: }
453: }
454:
455: void ndl_lcm(UINT *d1,unsigned *d2,UINT *d)
456: {
457: UINT t1,t2,u,u1,u2;
458: int i,j,l;
459:
460: if ( nd_module && (MPOS(d1) != MPOS(d2)) )
461: error("ndl_lcm : inconsistent monomials");
462: #if USE_UNROLL
463: switch ( nd_bpe ) {
464: case 3:
465: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
466: u1 = d1[i]; u2 = d2[i];
467: t1 = (u1&0x38000000); t2 = (u2&0x38000000); u = t1>t2?t1:t2;
468: t1 = (u1& 0x7000000); t2 = (u2& 0x7000000); u |= t1>t2?t1:t2;
469: t1 = (u1& 0xe00000); t2 = (u2& 0xe00000); u |= t1>t2?t1:t2;
470: t1 = (u1& 0x1c0000); t2 = (u2& 0x1c0000); u |= t1>t2?t1:t2;
471: t1 = (u1& 0x38000); t2 = (u2& 0x38000); u |= t1>t2?t1:t2;
472: t1 = (u1& 0x7000); t2 = (u2& 0x7000); u |= t1>t2?t1:t2;
473: t1 = (u1& 0xe00); t2 = (u2& 0xe00); u |= t1>t2?t1:t2;
474: t1 = (u1& 0x1c0); t2 = (u2& 0x1c0); u |= t1>t2?t1:t2;
475: t1 = (u1& 0x38); t2 = (u2& 0x38); u |= t1>t2?t1:t2;
476: t1 = (u1& 0x7); t2 = (u2& 0x7); u |= t1>t2?t1:t2;
477: d[i] = u;
478: }
479: break;
480: case 4:
481: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
482: u1 = d1[i]; u2 = d2[i];
483: t1 = (u1&0xf0000000); t2 = (u2&0xf0000000); u = t1>t2?t1:t2;
484: t1 = (u1& 0xf000000); t2 = (u2& 0xf000000); u |= t1>t2?t1:t2;
485: t1 = (u1& 0xf00000); t2 = (u2& 0xf00000); u |= t1>t2?t1:t2;
486: t1 = (u1& 0xf0000); t2 = (u2& 0xf0000); u |= t1>t2?t1:t2;
487: t1 = (u1& 0xf000); t2 = (u2& 0xf000); u |= t1>t2?t1:t2;
488: t1 = (u1& 0xf00); t2 = (u2& 0xf00); u |= t1>t2?t1:t2;
489: t1 = (u1& 0xf0); t2 = (u2& 0xf0); u |= t1>t2?t1:t2;
490: t1 = (u1& 0xf); t2 = (u2& 0xf); u |= t1>t2?t1:t2;
491: d[i] = u;
492: }
493: break;
494: case 6:
495: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
496: u1 = d1[i]; u2 = d2[i];
497: t1 = (u1&0x3f000000); t2 = (u2&0x3f000000); u = t1>t2?t1:t2;
498: t1 = (u1& 0xfc0000); t2 = (u2& 0xfc0000); u |= t1>t2?t1:t2;
499: t1 = (u1& 0x3f000); t2 = (u2& 0x3f000); u |= t1>t2?t1:t2;
500: t1 = (u1& 0xfc0); t2 = (u2& 0xfc0); u |= t1>t2?t1:t2;
501: t1 = (u1& 0x3f); t2 = (u2& 0x3f); u |= t1>t2?t1:t2;
502: d[i] = u;
503: }
504: break;
505: case 8:
506: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
507: u1 = d1[i]; u2 = d2[i];
508: t1 = (u1&0xff000000); t2 = (u2&0xff000000); u = t1>t2?t1:t2;
509: t1 = (u1& 0xff0000); t2 = (u2& 0xff0000); u |= t1>t2?t1:t2;
510: t1 = (u1& 0xff00); t2 = (u2& 0xff00); u |= t1>t2?t1:t2;
511: t1 = (u1& 0xff); t2 = (u2& 0xff); u |= t1>t2?t1:t2;
512: d[i] = u;
513: }
514: break;
515: case 16:
516: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
517: u1 = d1[i]; u2 = d2[i];
518: t1 = (u1&0xffff0000); t2 = (u2&0xffff0000); u = t1>t2?t1:t2;
519: t1 = (u1& 0xffff); t2 = (u2& 0xffff); u |= t1>t2?t1:t2;
520: d[i] = u;
521: }
522: break;
523: case 32:
524: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
525: u1 = d1[i]; u2 = d2[i];
526: d[i] = u1>u2?u1:u2;
527: }
528: break;
529: default:
530: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
531: u1 = d1[i]; u2 = d2[i];
532: for ( j = 0, u = 0; j < nd_epw; j++ ) {
533: t1 = (u1&nd_mask[j]); t2 = (u2&nd_mask[j]); u |= t1>t2?t1:t2;
534: }
535: d[i] = u;
536: }
537: break;
538: }
539: #else
540: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
541: u1 = d1[i]; u2 = d2[i];
542: for ( j = 0, u = 0; j < nd_epw; j++ ) {
543: t1 = (u1&nd_mask[j]); t2 = (u2&nd_mask[j]); u |= t1>t2?t1:t2;
544: }
545: d[i] = u;
546: }
547: #endif
548: if ( nd_module ) MPOS(d) = MPOS(d1);
549: TD(d) = ndl_weight(d);
550: if ( nd_blockmask ) ndl_weight_mask(d);
551: }
552:
553: void ndl_max(UINT *d1,unsigned *d2,UINT *d)
554: {
555: UINT t1,t2,u,u1,u2;
556: int i,j,l;
557:
558: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
559: u1 = d1[i]; u2 = d2[i];
560: for ( j = 0, u = 0; j < nd_epw; j++ ) {
561: t1 = (u1&nd_mask[j]); t2 = (u2&nd_mask[j]); u |= t1>t2?t1:t2;
562: }
563: d[i] = u;
564: }
565: }
566:
567: int ndl_weight(UINT *d)
568: {
569: UINT t,u;
570: int i,j;
571:
572: if ( current_dl_weight_vector )
573: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
574: u = GET_EXP(d,i);
575: t += MUL_WEIGHT(u,i);
576: }
577: else
578: for ( t = 0, i = nd_exporigin; i < nd_wpd; i++ ) {
579: u = d[i];
580: for ( j = 0; j < nd_epw; j++, u>>=nd_bpe )
581: t += (u&nd_mask0);
582: }
1.20 noro 583: if ( nd_module && nd_module_rank && MPOS(d) )
584: t += nd_module_weight[MPOS(d)-1];
585: for ( i = nd_exporigin; i < nd_wpd; i++ )
586: if ( d[i] && !t )
587: printf("afo\n");
1.1 noro 588: return t;
589: }
590:
591: /* for sugarweight */
592:
593: int ndl_weight2(UINT *d)
594: {
595: int t,u;
596: int i,j;
597:
598: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
599: u = GET_EXP(d,i);
600: t += nd_sugarweight[i]*u;
601: }
1.20 noro 602: if ( nd_module && nd_module_rank && MPOS(d) )
603: t += nd_module_weight[MPOS(d)-1];
1.1 noro 604: return t;
605: }
606:
607: void ndl_weight_mask(UINT *d)
608: {
609: UINT t,u;
610: UINT *mask;
611: int i,j,k,l;
612:
613: l = nd_blockmask->n;
614: for ( k = 0; k < l; k++ ) {
615: mask = nd_blockmask->mask[k];
616: if ( current_dl_weight_vector )
617: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
618: u = GET_EXP_MASK(d,i,mask);
619: t += MUL_WEIGHT(u,i);
620: }
621: else
622: for ( t = 0, i = nd_exporigin; i < nd_wpd; i++ ) {
623: u = d[i]&mask[i];
624: for ( j = 0; j < nd_epw; j++, u>>=nd_bpe )
625: t += (u&nd_mask0);
626: }
627: d[k+1] = t;
628: }
629: }
630:
1.21 noro 631: int ndl_glex_compare(UINT *d1,UINT *d2)
632: {
633: if ( TD(d1) > TD(d2) ) return 1;
634: else if ( TD(d1) < TD(d2) ) return -1;
635: else return ndl_lex_compare(d1,d2);
636: }
637:
1.1 noro 638: int ndl_lex_compare(UINT *d1,UINT *d2)
639: {
640: int i;
641:
642: d1 += nd_exporigin;
643: d2 += nd_exporigin;
644: for ( i = nd_exporigin; i < nd_wpd; i++, d1++, d2++ )
645: if ( *d1 > *d2 )
646: return nd_isrlex ? -1 : 1;
647: else if ( *d1 < *d2 )
648: return nd_isrlex ? 1 : -1;
649: return 0;
650: }
651:
652: int ndl_block_compare(UINT *d1,UINT *d2)
653: {
654: int i,l,j,ord_o,ord_l;
655: struct order_pair *op;
656: UINT t1,t2,m;
657: UINT *mask;
658:
659: l = nd_blockmask->n;
660: op = nd_blockmask->order_pair;
661: for ( j = 0; j < l; j++ ) {
662: mask = nd_blockmask->mask[j];
663: ord_o = op[j].order;
664: if ( ord_o < 2 ) {
665: if ( (t1=d1[j+1]) > (t2=d2[j+1]) ) return 1;
666: else if ( t1 < t2 ) return -1;
667: }
668: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
669: m = mask[i];
670: t1 = d1[i]&m;
671: t2 = d2[i]&m;
672: if ( t1 > t2 )
673: return !ord_o ? -1 : 1;
674: else if ( t1 < t2 )
675: return !ord_o ? 1 : -1;
676: }
677: }
678: return 0;
679: }
680:
681: int ndl_matrix_compare(UINT *d1,UINT *d2)
682: {
683: int i,j,s,row;
684: int *v;
685: Z **mat;
686: Z *w;
687: Z t1;
688: Z t,t2;
689:
1.6 noro 690: for ( j = 0; j < nd_nvar; j++ )
691: nd_work_vector[j] = GET_EXP(d1,j)-GET_EXP(d2,j);
1.1 noro 692: if ( nd_top_weight ) {
693: if ( OID(nd_top_weight) == O_VECT ) {
1.6 noro 694: mat = (Z **)&BDY((VECT)nd_top_weight);
695: row = 1;
1.1 noro 696: } else {
697: mat = (Z **)BDY((MAT)nd_top_weight);
1.6 noro 698: row = ((MAT)nd_top_weight)->row;
1.1 noro 699: }
700: for ( i = 0; i < row; i++ ) {
1.6 noro 701: w = mat[i];
1.1 noro 702: for ( j = 0, t = 0; j < nd_nvar; j++ ) {
1.6 noro 703: STOZ(nd_work_vector[j],t1);
1.1 noro 704: mulz(w[j],t1,&t2);
705: addz(t,t2,&t1);
706: t = t1;
707: }
1.6 noro 708: if ( t ) {
709: s = sgnz(t);
1.1 noro 710: if ( s > 0 ) return 1;
711: else if ( s < 0 ) return -1;
1.6 noro 712: }
1.1 noro 713: }
1.6 noro 714: }
715: for ( i = 0; i < nd_matrix_len; i++ ) {
716: v = nd_matrix[i];
717: for ( j = 0, s = 0; j < nd_nvar; j++ )
718: s += v[j]*nd_work_vector[j];
719: if ( s > 0 ) return 1;
720: else if ( s < 0 ) return -1;
721: }
1.1 noro 722: if ( !ndl_equal(d1,d2) )
1.6 noro 723: error("ndl_matrix_compare : invalid matrix");
724: return 0;
1.1 noro 725: }
726:
727: int ndl_composite_compare(UINT *d1,UINT *d2)
728: {
729: int i,j,s,start,end,len,o;
730: int *v;
731: struct sparse_weight *sw;
732:
733: for ( j = 0; j < nd_nvar; j++ )
734: nd_work_vector[j] = GET_EXP(d1,j)-GET_EXP(d2,j);
735: for ( i = 0; i < nd_worb_len; i++ ) {
736: len = nd_worb[i].length;
737: switch ( nd_worb[i].type ) {
738: case IS_DENSE_WEIGHT:
739: v = nd_worb[i].body.dense_weight;
740: for ( j = 0, s = 0; j < len; j++ )
741: s += v[j]*nd_work_vector[j];
742: if ( s > 0 ) return 1;
743: else if ( s < 0 ) return -1;
744: break;
745: case IS_SPARSE_WEIGHT:
746: sw = nd_worb[i].body.sparse_weight;
747: for ( j = 0, s = 0; j < len; j++ )
748: s += sw[j].value*nd_work_vector[sw[j].pos];
749: if ( s > 0 ) return 1;
750: else if ( s < 0 ) return -1;
751: break;
752: case IS_BLOCK:
753: o = nd_worb[i].body.block.order;
754: start = nd_worb[i].body.block.start;
755: switch ( o ) {
756: case 0:
757: end = start+len;
758: for ( j = start, s = 0; j < end; j++ )
759: s += MUL_WEIGHT(nd_work_vector[j],j);
760: if ( s > 0 ) return 1;
761: else if ( s < 0 ) return -1;
762: for ( j = end-1; j >= start; j-- )
763: if ( nd_work_vector[j] < 0 ) return 1;
764: else if ( nd_work_vector[j] > 0 ) return -1;
765: break;
766: case 1:
767: end = start+len;
768: for ( j = start, s = 0; j < end; j++ )
769: s += MUL_WEIGHT(nd_work_vector[j],j);
770: if ( s > 0 ) return 1;
771: else if ( s < 0 ) return -1;
772: for ( j = start; j < end; j++ )
773: if ( nd_work_vector[j] > 0 ) return 1;
774: else if ( nd_work_vector[j] < 0 ) return -1;
775: break;
776: case 2:
777: end = start+len;
778: for ( j = start; j < end; j++ )
779: if ( nd_work_vector[j] > 0 ) return 1;
780: else if ( nd_work_vector[j] < 0 ) return -1;
781: break;
782: }
783: break;
784: }
785: }
786: return 0;
787: }
788:
789: /* TDH -> WW -> TD-> RL */
790:
791: int ndl_ww_lex_compare(UINT *d1,UINT *d2)
792: {
793: int i,m,e1,e2;
794:
795: if ( TD(d1) > TD(d2) ) return 1;
796: else if ( TD(d1) < TD(d2) ) return -1;
797: m = nd_nvar>>1;
798: for ( i = 0, e1 = e2 = 0; i < m; i++ ) {
799: e1 += current_weyl_weight_vector[i]*(GET_EXP(d1,m+i)-GET_EXP(d1,i));
800: e2 += current_weyl_weight_vector[i]*(GET_EXP(d2,m+i)-GET_EXP(d2,i));
801: }
802: if ( e1 > e2 ) return 1;
803: else if ( e1 < e2 ) return -1;
804: return ndl_lex_compare(d1,d2);
805: }
806:
1.21 noro 807: // common function for module glex and grlex comparison
808: int ndl_module_glex_compare(UINT *d1,UINT *d2)
1.1 noro 809: {
1.21 noro 810: int c;
1.1 noro 811:
1.21 noro 812: switch ( nd_module_ordtype ) {
813: case 0:
814: if ( TD(d1) > TD(d2) ) return 1;
815: else if ( TD(d1) < TD(d2) ) return -1;
816: else if ( (c = ndl_lex_compare(d1,d2)) != 0 ) return c;
817: else if ( MPOS(d1) < MPOS(d2) ) return 1;
818: else if ( MPOS(d1) > MPOS(d2) ) return -1;
819: else return 0;
820: break;
1.1 noro 821:
1.21 noro 822: case 1:
1.19 noro 823: if ( nd_pot_nelim && MPOS(d1)>=nd_pot_nelim+1 && MPOS(d2) >= nd_pot_nelim+1 ) {
824: if ( TD(d1) > TD(d2) ) return 1;
825: else if ( TD(d1) < TD(d2) ) return -1;
826: if ( (c = ndl_lex_compare(d1,d2)) != 0 ) return c;
827: if ( MPOS(d1) < MPOS(d2) ) return 1;
828: else if ( MPOS(d1) > MPOS(d2) ) return -1;
829: }
830: if ( MPOS(d1) < MPOS(d2) ) return 1;
831: else if ( MPOS(d1) > MPOS(d2) ) return -1;
1.21 noro 832: else if ( TD(d1) > TD(d2) ) return 1;
833: else if ( TD(d1) < TD(d2) ) return -1;
834: else return ndl_lex_compare(d1,d2);
835: break;
1.1 noro 836:
1.21 noro 837: case 2: // weight -> POT
838: if ( TD(d1) > TD(d2) ) return 1;
839: else if ( TD(d1) < TD(d2) ) return -1;
840: else if ( MPOS(d1) < MPOS(d2) ) return 1;
841: else if ( MPOS(d1) > MPOS(d2) ) return -1;
842: else return ndl_lex_compare(d1,d2);
843: break;
1.1 noro 844:
1.21 noro 845: default:
846: error("ndl_module_glex_compare : invalid module_ordtype");
847: }
1.1 noro 848: }
849:
1.21 noro 850: // common for module comparison
851: int ndl_module_compare(UINT *d1,UINT *d2)
1.1 noro 852: {
1.21 noro 853: int c;
1.1 noro 854:
1.21 noro 855: switch ( nd_module_ordtype ) {
856: case 0:
1.23 noro 857: if ( (c = (*ndl_base_compare_function)(d1,d2)) != 0 ) return c;
1.21 noro 858: else if ( MPOS(d1) > MPOS(d2) ) return -1;
859: else if ( MPOS(d1) < MPOS(d2) ) return 1;
860: else return 0;
861: break;
1.1 noro 862:
1.21 noro 863: case 1:
864: if ( MPOS(d1) < MPOS(d2) ) return 1;
865: else if ( MPOS(d1) > MPOS(d2) ) return -1;
866: else return (*ndl_base_compare_function)(d1,d2);
867: break;
1.1 noro 868:
1.21 noro 869: case 2: // weight -> POT
870: if ( TD(d1) > TD(d2) ) return 1;
871: else if ( TD(d1) < TD(d2) ) return -1;
872: else if ( MPOS(d1) < MPOS(d2) ) return 1;
873: else if ( MPOS(d1) > MPOS(d2) ) return -1;
874: else return (*ndl_base_compare_function)(d1,d2);
875: break;
1.1 noro 876:
1.21 noro 877: default:
878: error("ndl_module_compare : invalid module_ordtype");
879: }
1.1 noro 880: }
881:
1.21 noro 882: extern DMMstack dmm_stack;
883: void _addtodl(int n,DL d1,DL d2);
884: int _eqdl(int n,DL d1,DL d2);
885:
886: int ndl_module_schreyer_compare(UINT *m1,UINT *m2)
887: {
888: int pos1,pos2,t,j;
889: DMM *in;
890: DMMstack s;
891: static DL d1=0;
892: static DL d2=0;
893: static int dlen=0;
894:
895: pos1 = MPOS(m1); pos2 = MPOS(m2);
896: if ( pos1 == pos2 ) return (*ndl_base_compare_function)(m1,m2);
897: if ( nd_nvar > dlen ) {
898: NEWDL(d1,nd_nvar);
899: NEWDL(d2,nd_nvar);
900: dlen = nd_nvar;
901: }
902: d1->td = TD(m1);
903: for ( j = 0; j < nd_nvar; j++ ) d1->d[j] = GET_EXP(m1,j);
904: d2->td = TD(m2);
905: for ( j = 0; j < nd_nvar; j++ ) d2->d[j] = GET_EXP(m2,j);
906: for ( s = dmm_stack; s; s = NEXT(s) ) {
907: in = s->in;
908: _addtodl(nd_nvar,in[pos1]->dl,d1);
909: _addtodl(nd_nvar,in[pos2]->dl,d2);
910: if ( in[pos1]->pos == in[pos2]->pos && _eqdl(nd_nvar,d1,d2)) {
911: if ( pos1 < pos2 ) return 1;
912: else if ( pos1 > pos2 ) return -1;
913: else return 0;
914: }
915: pos1 = in[pos1]->pos;
916: pos2 = in[pos2]->pos;
917: if ( pos1 == pos2 ) return (*dl_base_compare_function)(nd_nvar,d1,d2);
918: }
919: // comparison by the bottom order
920: LAST:
921: switch ( nd_base_ordtype ) {
922: case 0:
923: t = (*dl_base_compare_function)(nd_nvar,d1,d2);
924: if ( t ) return t;
925: else if ( pos1 < pos2 ) return 1;
926: else if ( pos1 > pos2 ) return -1;
927: else return 0;
928: break;
929: case 1:
930: if ( pos1 < pos2 ) return 1;
931: else if ( pos1 > pos2 ) return -1;
932: else return (*dl_base_compare_function)(nd_nvar,d1,d2);
933: break;
934: case 2:
935: if ( d1->td > d2->td ) return 1;
936: else if ( d1->td < d2->td ) return -1;
937: else if ( pos1 < pos2 ) return 1;
938: else if ( pos1 > pos2 ) return -1;
939: else return (*dl_base_compare_function)(nd_nvar,d1,d2);
940: break;
941: default:
942: error("ndl_schreyer_compare : invalid base ordtype");
943: }
1.1 noro 944: }
945:
946: INLINE int ndl_equal(UINT *d1,UINT *d2)
947: {
948: int i;
949:
950: switch ( nd_wpd ) {
951: case 2:
952: if ( TD(d2) != TD(d1) ) return 0;
953: if ( d2[1] != d1[1] ) return 0;
954: return 1;
955: break;
956: case 3:
957: if ( TD(d2) != TD(d1) ) return 0;
958: if ( d2[1] != d1[1] ) return 0;
959: if ( d2[2] != d1[2] ) return 0;
960: return 1;
961: break;
962: default:
963: for ( i = 0; i < nd_wpd; i++ )
964: if ( *d1++ != *d2++ ) return 0;
965: return 1;
966: break;
967: }
968: }
969:
970: INLINE void ndl_copy(UINT *d1,UINT *d2)
971: {
972: int i;
973:
974: switch ( nd_wpd ) {
975: case 2:
976: TD(d2) = TD(d1);
977: d2[1] = d1[1];
978: break;
979: case 3:
980: TD(d2) = TD(d1);
981: d2[1] = d1[1];
982: d2[2] = d1[2];
983: break;
984: default:
985: for ( i = 0; i < nd_wpd; i++ )
986: d2[i] = d1[i];
987: break;
988: }
989: }
990:
991: INLINE void ndl_zero(UINT *d)
992: {
993: int i;
994: for ( i = 0; i < nd_wpd; i++ ) d[i] = 0;
995: }
996:
997: INLINE void ndl_add(UINT *d1,UINT *d2,UINT *d)
998: {
999: int i;
1000:
1001: if ( nd_module ) {
1002: if ( MPOS(d1) && MPOS(d2) && (MPOS(d1) != MPOS(d2)) )
1003: error("ndl_add : invalid operation");
1004: }
1005: #if 1
1006: switch ( nd_wpd ) {
1007: case 2:
1008: TD(d) = TD(d1)+TD(d2);
1009: d[1] = d1[1]+d2[1];
1010: break;
1011: case 3:
1012: TD(d) = TD(d1)+TD(d2);
1013: d[1] = d1[1]+d2[1];
1014: d[2] = d1[2]+d2[2];
1015: break;
1016: default:
1017: for ( i = 0; i < nd_wpd; i++ ) d[i] = d1[i]+d2[i];
1018: break;
1019: }
1020: #else
1021: for ( i = 0; i < nd_wpd; i++ ) d[i] = d1[i]+d2[i];
1022: #endif
1023: }
1024:
1025: /* d1 += d2 */
1026: INLINE void ndl_addto(UINT *d1,UINT *d2)
1027: {
1028: int i;
1029:
1030: if ( nd_module ) {
1031: if ( MPOS(d1) && MPOS(d2) && (MPOS(d1) != MPOS(d2)) )
1032: error("ndl_addto : invalid operation");
1033: }
1034: #if 1
1035: switch ( nd_wpd ) {
1036: case 2:
1037: TD(d1) += TD(d2);
1038: d1[1] += d2[1];
1039: break;
1040: case 3:
1041: TD(d1) += TD(d2);
1042: d1[1] += d2[1];
1043: d1[2] += d2[2];
1044: break;
1045: default:
1046: for ( i = 0; i < nd_wpd; i++ ) d1[i] += d2[i];
1047: break;
1048: }
1049: #else
1050: for ( i = 0; i < nd_wpd; i++ ) d1[i] += d2[i];
1051: #endif
1052: }
1053:
1.24 noro 1054: /* d1 -= d2 */
1055: INLINE void ndl_subfrom(UINT *d1,UINT *d2)
1056: {
1057: int i;
1058:
1059: if ( nd_module ) {
1060: if ( MPOS(d1) && MPOS(d2) && (MPOS(d1) != MPOS(d2)) )
1061: error("ndl_addto : invalid operation");
1062: }
1063: #if 1
1064: switch ( nd_wpd ) {
1065: case 2:
1066: TD(d1) -= TD(d2);
1067: d1[1] -= d2[1];
1068: break;
1069: case 3:
1070: TD(d1) -= TD(d2);
1071: d1[1] -= d2[1];
1072: d1[2] -= d2[2];
1073: break;
1074: default:
1075: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
1076: break;
1077: }
1078: #else
1079: for ( i = 0; i < nd_wpd; i++ ) d1[i] -= d2[i];
1080: #endif
1081: }
1082:
1.1 noro 1083: INLINE void ndl_sub(UINT *d1,UINT *d2,UINT *d)
1084: {
1085: int i;
1086:
1087: for ( i = 0; i < nd_wpd; i++ ) d[i] = d1[i]-d2[i];
1088: }
1089:
1090: int ndl_disjoint(UINT *d1,UINT *d2)
1091: {
1092: UINT t1,t2,u,u1,u2;
1093: int i,j;
1094:
1095: if ( nd_module && (MPOS(d1) == MPOS(d2)) ) return 0;
1096: #if USE_UNROLL
1097: switch ( nd_bpe ) {
1098: case 3:
1099: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1100: u1 = d1[i]; u2 = d2[i];
1101: t1 = u1&0x38000000; t2 = u2&0x38000000; if ( t1&&t2 ) return 0;
1102: t1 = u1& 0x7000000; t2 = u2& 0x7000000; if ( t1&&t2 ) return 0;
1103: t1 = u1& 0xe00000; t2 = u2& 0xe00000; if ( t1&&t2 ) return 0;
1104: t1 = u1& 0x1c0000; t2 = u2& 0x1c0000; if ( t1&&t2 ) return 0;
1105: t1 = u1& 0x38000; t2 = u2& 0x38000; if ( t1&&t2 ) return 0;
1106: t1 = u1& 0x7000; t2 = u2& 0x7000; if ( t1&&t2 ) return 0;
1107: t1 = u1& 0xe00; t2 = u2& 0xe00; if ( t1&&t2 ) return 0;
1108: t1 = u1& 0x1c0; t2 = u2& 0x1c0; if ( t1&&t2 ) return 0;
1109: t1 = u1& 0x38; t2 = u2& 0x38; if ( t1&&t2 ) return 0;
1110: t1 = u1& 0x7; t2 = u2& 0x7; if ( t1&&t2 ) return 0;
1111: }
1112: return 1;
1113: break;
1114: case 4:
1115: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1116: u1 = d1[i]; u2 = d2[i];
1117: t1 = u1&0xf0000000; t2 = u2&0xf0000000; if ( t1&&t2 ) return 0;
1118: t1 = u1& 0xf000000; t2 = u2& 0xf000000; if ( t1&&t2 ) return 0;
1119: t1 = u1& 0xf00000; t2 = u2& 0xf00000; if ( t1&&t2 ) return 0;
1120: t1 = u1& 0xf0000; t2 = u2& 0xf0000; if ( t1&&t2 ) return 0;
1121: t1 = u1& 0xf000; t2 = u2& 0xf000; if ( t1&&t2 ) return 0;
1122: t1 = u1& 0xf00; t2 = u2& 0xf00; if ( t1&&t2 ) return 0;
1123: t1 = u1& 0xf0; t2 = u2& 0xf0; if ( t1&&t2 ) return 0;
1124: t1 = u1& 0xf; t2 = u2& 0xf; if ( t1&&t2 ) return 0;
1125: }
1126: return 1;
1127: break;
1128: case 6:
1129: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1130: u1 = d1[i]; u2 = d2[i];
1131: t1 = u1&0x3f000000; t2 = u2&0x3f000000; if ( t1&&t2 ) return 0;
1132: t1 = u1& 0xfc0000; t2 = u2& 0xfc0000; if ( t1&&t2 ) return 0;
1133: t1 = u1& 0x3f000; t2 = u2& 0x3f000; if ( t1&&t2 ) return 0;
1134: t1 = u1& 0xfc0; t2 = u2& 0xfc0; if ( t1&&t2 ) return 0;
1135: t1 = u1& 0x3f; t2 = u2& 0x3f; if ( t1&&t2 ) return 0;
1136: }
1137: return 1;
1138: break;
1139: case 8:
1140: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1141: u1 = d1[i]; u2 = d2[i];
1142: t1 = u1&0xff000000; t2 = u2&0xff000000; if ( t1&&t2 ) return 0;
1143: t1 = u1& 0xff0000; t2 = u2& 0xff0000; if ( t1&&t2 ) return 0;
1144: t1 = u1& 0xff00; t2 = u2& 0xff00; if ( t1&&t2 ) return 0;
1145: t1 = u1& 0xff; t2 = u2& 0xff; if ( t1&&t2 ) return 0;
1146: }
1147: return 1;
1148: break;
1149: case 16:
1150: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1151: u1 = d1[i]; u2 = d2[i];
1152: t1 = u1&0xffff0000; t2 = u2&0xffff0000; if ( t1&&t2 ) return 0;
1153: t1 = u1& 0xffff; t2 = u2& 0xffff; if ( t1&&t2 ) return 0;
1154: }
1155: return 1;
1156: break;
1157: case 32:
1158: for ( i = nd_exporigin; i < nd_wpd; i++ )
1159: if ( d1[i] && d2[i] ) return 0;
1160: return 1;
1161: break;
1162: default:
1163: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1164: u1 = d1[i]; u2 = d2[i];
1165: for ( j = 0; j < nd_epw; j++ ) {
1166: if ( (u1&nd_mask0) && (u2&nd_mask0) ) return 0;
1167: u1 >>= nd_bpe; u2 >>= nd_bpe;
1168: }
1169: }
1170: return 1;
1171: break;
1172: }
1173: #else
1174: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1175: u1 = d1[i]; u2 = d2[i];
1176: for ( j = 0; j < nd_epw; j++ ) {
1177: if ( (u1&nd_mask0) && (u2&nd_mask0) ) return 0;
1178: u1 >>= nd_bpe; u2 >>= nd_bpe;
1179: }
1180: }
1181: return 1;
1182: #endif
1183: }
1184:
1185: int ndl_check_bound(UINT *d1,UINT *d2)
1186: {
1187: UINT u2;
1188: int i,j,ind,k;
1189:
1190: ind = 0;
1191: #if USE_UNROLL
1192: switch ( nd_bpe ) {
1193: case 3:
1194: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1195: u2 = d2[i];
1196: if ( d1[ind++]+((u2>>27)&0x7) >= 0x8 ) return 1;
1197: if ( d1[ind++]+((u2>>24)&0x7) >= 0x8 ) return 1;
1198: if ( d1[ind++]+((u2>>21)&0x7) >= 0x8 ) return 1;
1199: if ( d1[ind++]+((u2>>18)&0x7) >= 0x8 ) return 1;
1200: if ( d1[ind++]+((u2>>15)&0x7) >= 0x8 ) return 1;
1201: if ( d1[ind++]+((u2>>12)&0x7) >= 0x8 ) return 1;
1202: if ( d1[ind++]+((u2>>9)&0x7) >= 0x8 ) return 1;
1203: if ( d1[ind++]+((u2>>6)&0x7) >= 0x8 ) return 1;
1204: if ( d1[ind++]+((u2>>3)&0x7) >= 0x8 ) return 1;
1205: if ( d1[ind++]+(u2&0x7) >= 0x8 ) return 1;
1206: }
1207: return 0;
1208: break;
1209: case 4:
1210: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1211: u2 = d2[i];
1212: if ( d1[ind++]+((u2>>28)&0xf) >= 0x10 ) return 1;
1213: if ( d1[ind++]+((u2>>24)&0xf) >= 0x10 ) return 1;
1214: if ( d1[ind++]+((u2>>20)&0xf) >= 0x10 ) return 1;
1215: if ( d1[ind++]+((u2>>16)&0xf) >= 0x10 ) return 1;
1216: if ( d1[ind++]+((u2>>12)&0xf) >= 0x10 ) return 1;
1217: if ( d1[ind++]+((u2>>8)&0xf) >= 0x10 ) return 1;
1218: if ( d1[ind++]+((u2>>4)&0xf) >= 0x10 ) return 1;
1219: if ( d1[ind++]+(u2&0xf) >= 0x10 ) return 1;
1220: }
1221: return 0;
1222: break;
1223: case 6:
1224: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1225: u2 = d2[i];
1226: if ( d1[ind++]+((u2>>24)&0x3f) >= 0x40 ) return 1;
1227: if ( d1[ind++]+((u2>>18)&0x3f) >= 0x40 ) return 1;
1228: if ( d1[ind++]+((u2>>12)&0x3f) >= 0x40 ) return 1;
1229: if ( d1[ind++]+((u2>>6)&0x3f) >= 0x40 ) return 1;
1230: if ( d1[ind++]+(u2&0x3f) >= 0x40 ) return 1;
1231: }
1232: return 0;
1233: break;
1234: case 8:
1235: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1236: u2 = d2[i];
1237: if ( d1[ind++]+((u2>>24)&0xff) >= 0x100 ) return 1;
1238: if ( d1[ind++]+((u2>>16)&0xff) >= 0x100 ) return 1;
1239: if ( d1[ind++]+((u2>>8)&0xff) >= 0x100 ) return 1;
1240: if ( d1[ind++]+(u2&0xff) >= 0x100 ) return 1;
1241: }
1242: return 0;
1243: break;
1244: case 16:
1245: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1246: u2 = d2[i];
1247: if ( d1[ind++]+((u2>>16)&0xffff) > 0x10000 ) return 1;
1248: if ( d1[ind++]+(u2&0xffff) > 0x10000 ) return 1;
1249: }
1250: return 0;
1251: break;
1252: case 32:
1253: for ( i = nd_exporigin; i < nd_wpd; i++ )
1254: if ( d1[i]+d2[i]<d1[i] ) return 1;
1255: return 0;
1256: break;
1257: default:
1258: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1259: u2 = d2[i];
1260: k = (nd_epw-1)*nd_bpe;
1261: for ( j = 0; j < nd_epw; j++, k -= nd_bpe )
1262: if ( d1[ind++]+((u2>>k)&nd_mask0) > nd_mask0 ) return 1;
1263: }
1264: return 0;
1265: break;
1266: }
1267: #else
1268: for ( i = nd_exporigin; i < nd_wpd; i++ ) {
1269: u2 = d2[i];
1270: k = (nd_epw-1)*nd_bpe;
1271: for ( j = 0; j < nd_epw; j++, k -= nd_bpe )
1272: if ( d1[ind++]+((u2>>k)&nd_mask0) > nd_mask0 ) return 1;
1273: }
1274: return 0;
1275: #endif
1276: }
1277:
1278: int ndl_check_bound2(int index,UINT *d2)
1279: {
1280: return ndl_check_bound(nd_bound[index],d2);
1281: }
1282:
1283: INLINE int ndl_hash_value(UINT *d)
1284: {
1285: int i;
1.11 noro 1286: UINT r;
1.1 noro 1287:
1288: r = 0;
1289: for ( i = 0; i < nd_wpd; i++ )
1.12 noro 1290: r = (r*1511+d[i]);
1.11 noro 1291: r %= REDTAB_LEN;
1.1 noro 1292: return r;
1293: }
1294:
1295: INLINE int ndl_find_reducer(UINT *dg)
1296: {
1297: RHist r;
1298: int d,k,i;
1299:
1300: d = ndl_hash_value(dg);
1301: for ( r = nd_red[d], k = 0; r; r = NEXT(r), k++ ) {
1302: if ( ndl_equal(dg,DL(r)) ) {
1303: if ( k > 0 ) nd_notfirst++;
1304: nd_found++;
1305: return r->index;
1306: }
1307: }
1308: if ( Reverse )
1309: for ( i = nd_psn-1; i >= 0; i-- ) {
1310: r = nd_psh[i];
1311: if ( ndl_reducible(dg,DL(r)) ) {
1312: nd_create++;
1313: nd_append_red(dg,i);
1314: return i;
1315: }
1316: }
1317: else
1318: for ( i = 0; i < nd_psn; i++ ) {
1319: r = nd_psh[i];
1320: if ( ndl_reducible(dg,DL(r)) ) {
1321: nd_create++;
1322: nd_append_red(dg,i);
1323: return i;
1324: }
1325: }
1326: return -1;
1327: }
1328:
1.24 noro 1329: // ret=0,...,nd_psn-1 => reducer found
1330: // ret=nd_psn => reducer not found
1331: // ret=-1 => singular top reducible
1332:
1333: int comp_sig(SIG s1,SIG s2);
1334: void _ndltodl(UINT *ndl,DL dl);
1335:
1336: void print_sig(SIG s)
1337: {
1338: int i;
1339:
1340: fprintf(asir_out,"<<");
1341: for ( i = 0; i < nd_nvar; i++ ) {
1342: fprintf(asir_out,"%d",s->dl->d[i]);
1343: if ( i != nd_nvar-1 ) fprintf(asir_out,",");
1344: }
1345: fprintf(asir_out,">>*e%d",s->pos);
1346: }
1347:
1348: INLINE int ndl_find_reducer_s(UINT *dg,SIG sig)
1349: {
1350: RHist r;
1351: int i,singular,ret;
1352: static int wpd;
1353: static SIG quo;
1354: static UINT *tmp;
1355:
1356: if ( wpd < nd_wpd ) {
1357: wpd = nd_wpd;
1358: NEWSIG(quo);
1359: tmp = (UINT *)MALLOC(wpd*sizeof(UINT));
1360: }
1361: singular = 0;
1362: for ( i = 0; i < nd_psn; i++ ) {
1363: r = nd_psh[i];
1364: if ( ndl_reducible(dg,DL(r)) ) {
1365: ndl_copy(dg,tmp);
1366: ndl_subfrom(tmp,DL(r));
1367: _ndltodl(tmp,DL(quo));
1368: _addtodl(nd_nvar,DL(nd_psh[i]->sig),DL(quo));
1369: quo->pos = nd_psh[i]->sig->pos;
1370: ret = comp_sig(sig,quo);
1371: if ( ret > 0 ) { singular = 0; break; }
1372: if ( ret == 0 ) { singular = 1; }
1373: }
1374: }
1375: if ( singular ) return -1;
1376: else return i;
1377: }
1378:
1.1 noro 1379: ND nd_merge(ND p1,ND p2)
1380: {
1381: int n,c;
1382: int t,can,td1,td2;
1383: ND r;
1384: NM m1,m2,mr0,mr,s;
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: s = m1; m1 = NEXT(m1);
1395: can++; NEXTNM2(mr0,mr,s);
1396: s = m2; m2 = NEXT(m2); FREENM(s);
1397: break;
1398: case 1:
1399: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1400: break;
1401: case -1:
1402: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1403: break;
1404: }
1405: }
1406: if ( !mr0 )
1407: if ( m1 ) mr0 = m1;
1408: else if ( m2 ) mr0 = m2;
1409: else return 0;
1410: else if ( m1 ) NEXT(mr) = m1;
1411: else if ( m2 ) NEXT(mr) = m2;
1412: else NEXT(mr) = 0;
1413: BDY(p1) = mr0;
1414: SG(p1) = MAX(SG(p1),SG(p2));
1415: LEN(p1) = LEN(p1)+LEN(p2)-can;
1416: FREEND(p2);
1417: return p1;
1418: }
1419: }
1420:
1421: ND nd_add(int mod,ND p1,ND p2)
1422: {
1423: int n,c;
1424: int t,can,td1,td2;
1425: ND r;
1426: NM m1,m2,mr0,mr,s;
1427:
1.11 noro 1428: Nnd_add++;
1.1 noro 1429: if ( !p1 ) return p2;
1430: else if ( !p2 ) return p1;
1431: else if ( mod == -1 ) return nd_add_sf(p1,p2);
1432: else if ( mod == -2 ) return nd_add_lf(p1,p2);
1433: else if ( !mod ) return nd_add_q(p1,p2);
1434: else {
1435: can = 0;
1436: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1437: c = DL_COMPARE(DL(m1),DL(m2));
1438: switch ( c ) {
1439: case 0:
1440: t = ((CM(m1))+(CM(m2))) - mod;
1441: if ( t < 0 ) t += mod;
1442: s = m1; m1 = NEXT(m1);
1443: if ( t ) {
1444: can++; NEXTNM2(mr0,mr,s); CM(mr) = (t);
1445: } else {
1446: can += 2; FREENM(s);
1447: }
1448: s = m2; m2 = NEXT(m2); FREENM(s);
1449: break;
1450: case 1:
1451: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1452: break;
1453: case -1:
1454: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1455: break;
1456: }
1457: }
1458: if ( !mr0 )
1459: if ( m1 ) mr0 = m1;
1460: else if ( m2 ) mr0 = m2;
1461: else return 0;
1462: else if ( m1 ) NEXT(mr) = m1;
1463: else if ( m2 ) NEXT(mr) = m2;
1464: else NEXT(mr) = 0;
1465: BDY(p1) = mr0;
1466: SG(p1) = MAX(SG(p1),SG(p2));
1467: LEN(p1) = LEN(p1)+LEN(p2)-can;
1468: FREEND(p2);
1469: return p1;
1470: }
1471: }
1472:
1473: /* XXX on opteron, the inlined manipulation of destructive additon of
1474: * two NM seems to make gcc optimizer get confused, so the part is
1475: * done in a function.
1476: */
1477:
1478: int nm_destructive_add_q(NM *m1,NM *m2,NM *mr0,NM *mr)
1479: {
1480: NM s;
1481: P t;
1482: int can;
1483:
1484: addp(nd_vc,CP(*m1),CP(*m2),&t);
1485: s = *m1; *m1 = NEXT(*m1);
1486: if ( t ) {
1487: can = 1; NEXTNM2(*mr0,*mr,s); CP(*mr) = (t);
1488: } else {
1489: can = 2; FREENM(s);
1490: }
1491: s = *m2; *m2 = NEXT(*m2); FREENM(s);
1492: return can;
1493: }
1494:
1495: ND nd_add_q(ND p1,ND p2)
1496: {
1497: int n,c,can;
1498: ND r;
1499: NM m1,m2,mr0,mr,s;
1500: P t;
1501:
1502: if ( !p1 ) return p2;
1503: else if ( !p2 ) return p1;
1504: else {
1505: can = 0;
1506: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1507: c = DL_COMPARE(DL(m1),DL(m2));
1508: switch ( c ) {
1509: case 0:
1510: #if defined(__x86_64__)
1511: can += nm_destructive_add_q(&m1,&m2,&mr0,&mr);
1512: #else
1513: addp(nd_vc,CP(m1),CP(m2),&t);
1514: s = m1; m1 = NEXT(m1);
1515: if ( t ) {
1516: can++; NEXTNM2(mr0,mr,s); CP(mr) = (t);
1517: } else {
1518: can += 2; FREENM(s);
1519: }
1520: s = m2; m2 = NEXT(m2); FREENM(s);
1521: #endif
1522: break;
1523: case 1:
1524: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1525: break;
1526: case -1:
1527: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1528: break;
1529: }
1530: }
1531: if ( !mr0 )
1532: if ( m1 ) mr0 = m1;
1533: else if ( m2 ) mr0 = m2;
1534: else return 0;
1535: else if ( m1 ) NEXT(mr) = m1;
1536: else if ( m2 ) NEXT(mr) = m2;
1537: else NEXT(mr) = 0;
1538: BDY(p1) = mr0;
1539: SG(p1) = MAX(SG(p1),SG(p2));
1540: LEN(p1) = LEN(p1)+LEN(p2)-can;
1541: FREEND(p2);
1542: return p1;
1543: }
1544: }
1545:
1546: ND nd_add_sf(ND p1,ND p2)
1547: {
1548: int n,c,can;
1549: ND r;
1550: NM m1,m2,mr0,mr,s;
1551: int t;
1552:
1553: if ( !p1 ) return p2;
1554: else if ( !p2 ) return p1;
1555: else {
1556: can = 0;
1557: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
1558: c = DL_COMPARE(DL(m1),DL(m2));
1559: switch ( c ) {
1560: case 0:
1561: t = _addsf(CM(m1),CM(m2));
1562: s = m1; m1 = NEXT(m1);
1563: if ( t ) {
1564: can++; NEXTNM2(mr0,mr,s); CM(mr) = (t);
1565: } else {
1566: can += 2; FREENM(s);
1567: }
1568: s = m2; m2 = NEXT(m2); FREENM(s);
1569: break;
1570: case 1:
1571: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
1572: break;
1573: case -1:
1574: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
1575: break;
1576: }
1577: }
1578: if ( !mr0 )
1579: if ( m1 ) mr0 = m1;
1580: else if ( m2 ) mr0 = m2;
1581: else return 0;
1582: else if ( m1 ) NEXT(mr) = m1;
1583: else if ( m2 ) NEXT(mr) = m2;
1584: else NEXT(mr) = 0;
1585: BDY(p1) = mr0;
1586: SG(p1) = MAX(SG(p1),SG(p2));
1587: LEN(p1) = LEN(p1)+LEN(p2)-can;
1588: FREEND(p2);
1589: return p1;
1590: }
1591: }
1592:
1593:
1594: ND nd_reduce2(int mod,ND d,ND g,NDV p,NM mul,NDC dn,Obj *divp)
1595: {
1596: int c,c1,c2;
1597: Z cg,cred,gcd,tq;
1598: P cgp,credp,gcdp;
1599: Obj tr,tr1;
1600:
1601: if ( mod == -1 ) {
1602: CM(mul) = _mulsf(_invsf(HCM(p)),_chsgnsf(HCM(g)));
1603: *divp = (Obj)ONE;
1604: } else if ( mod == -2 ) {
1605: Z inv,t;
1606: divlf(ONE,HCZ(p),&inv);
1607: chsgnlf(HCZ(g),&t);
1608: mullf(inv,t,&CZ(mul));
1609: *divp = (Obj)ONE;
1610: } else if ( mod ) {
1611: c1 = invm(HCM(p),mod); c2 = mod-HCM(g);
1612: DMAR(c1,c2,0,mod,c); CM(mul) = c;
1613: *divp = (Obj)ONE;
1614: } else if ( nd_vc ) {
1615: ezgcdpz(nd_vc,HCP(g),HCP(p),&gcdp);
1616: divsp(nd_vc,HCP(g),gcdp,&cgp); divsp(nd_vc,HCP(p),gcdp,&credp);
1617: chsgnp(cgp,&CP(mul));
1618: nd_mul_c_q(d,credp); nd_mul_c_q(g,credp);
1619: if ( dn ) {
1620: mulr(nd_vc,(Obj)dn->r,(Obj)credp,&tr);
1621: reductr(nd_vc,tr,&tr1); dn->r = (R)tr1;
1622: }
1623: *divp = (Obj)credp;
1624: } else {
1.6 noro 1625: igcd_cofactor(HCZ(g),HCZ(p),&gcd,&cg,&cred);
1626: chsgnz(cg,&CZ(mul));
1.1 noro 1627: nd_mul_c_q(d,(P)cred); nd_mul_c_q(g,(P)cred);
1628: if ( dn ) {
1629: mulz(dn->z,cred,&tq); dn->z = tq;
1630: }
1631: *divp = (Obj)cred;
1632: }
1633: return nd_add(mod,g,ndv_mul_nm(mod,mul,p));
1634: }
1635:
1636: /* ret=1 : success, ret=0 : overflow */
1.6 noro 1637: int nd_nf(int mod,ND d,ND g,NDV *ps,int full,ND *rp)
1.1 noro 1638: {
1639: NM m,mrd,tail;
1640: NM mul;
1641: int n,sugar,psugar,sugar0,stat,index;
1642: int c,c1,c2,dummy;
1643: RHist h;
1644: NDV p,red;
1645: Q cg,cred,gcd,tq,qq;
1646: Z iq;
1647: DP dmul;
1648: NODE node;
1649: LIST hist;
1650: double hmag;
1651: P tp,tp1;
1652: Obj tr,tr1,div;
1653: union oNDC hg;
1654: P cont;
1655:
1656: if ( !g ) {
1657: *rp = d;
1658: return 1;
1659: }
1660: if ( !mod ) hmag = ((double)p_mag(HCP(g)))*nd_scale;
1661:
1662: sugar0 = sugar = SG(g);
1663: n = NV(g);
1664: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
1665: if ( d )
1666: for ( tail = BDY(d); NEXT(tail); tail = NEXT(tail) );
1667: for ( ; g; ) {
1668: index = ndl_find_reducer(HDL(g));
1669: if ( index >= 0 ) {
1670: h = nd_psh[index];
1671: ndl_sub(HDL(g),DL(h),DL(mul));
1672: if ( ndl_check_bound2(index,DL(mul)) ) {
1673: nd_free(g); nd_free(d);
1674: return 0;
1675: }
1676: p = nd_demand ? ndv_load(index) : ps[index];
1677: /* d+g -> div*(d+g)+mul*p */
1.6 noro 1678: g = nd_reduce2(mod,d,g,p,mul,0,&div);
1.1 noro 1679: if ( nd_gentrace ) {
1680: /* Trace=[div,index,mul,ONE] */
1.6 noro 1681: STOZ(index,iq);
1.1 noro 1682: nmtodp(mod,mul,&dmul);
1683: node = mknode(4,div,iq,dmul,ONE);
1684: }
1685: sugar = MAX(sugar,SG(p)+TD(DL(mul)));
1686: if ( !mod && g && !nd_vc && ((double)(p_mag(HCP(g))) > hmag) ) {
1687: hg = HCU(g);
1688: nd_removecont2(d,g);
1.6 noro 1689: if ( nd_gentrace ) {
1.1 noro 1690: /* overwrite cont : Trace=[div,index,mul,cont] */
1.6 noro 1691: /* exact division */
1.1 noro 1692: cont = ndc_div(mod,hg,HCU(g));
1693: if ( nd_gentrace && !UNIQ(cont) ) ARG3(node) = (pointer)cont;
1694: }
1695: hmag = ((double)p_mag(HCP(g)))*nd_scale;
1696: }
1697: MKLIST(hist,node);
1698: MKNODE(node,hist,nd_tracelist); nd_tracelist = node;
1699: } else if ( !full ) {
1700: *rp = g;
1701: return 1;
1702: } else {
1703: m = BDY(g);
1704: if ( NEXT(m) ) {
1705: BDY(g) = NEXT(m); NEXT(m) = 0; LEN(g)--;
1706: } else {
1707: FREEND(g); g = 0;
1708: }
1709: if ( d ) {
1710: NEXT(tail)=m; tail=m; LEN(d)++;
1711: } else {
1712: MKND(n,m,1,d); tail = BDY(d);
1713: }
1714: }
1715: }
1716: if ( d ) SG(d) = sugar;
1717: *rp = d;
1718: return 1;
1719: }
1720:
1.24 noro 1721: // ret=1 => success
1722: // ret=0 => overflow
1723: // ret=-1 => singular top reducible
1724:
1725: int nd_nf_s(int mod,ND d,ND g,NDV *ps,int full,ND *rp)
1726: {
1727: NM m,mrd,tail;
1728: NM mul;
1729: int n,sugar,psugar,sugar0,stat,index;
1730: int c,c1,c2,dummy;
1731: RHist h;
1732: NDV p,red;
1733: Q cg,cred,gcd,tq,qq;
1734: Z iq;
1735: DP dmul;
1736: NODE node;
1737: LIST hist;
1738: double hmag;
1739: P tp,tp1;
1740: Obj tr,tr1,div;
1741: union oNDC hg;
1742: P cont;
1743: SIG sig;
1744:
1745: if ( !g ) {
1746: *rp = d;
1747: return 1;
1748: }
1749: if ( !mod ) hmag = ((double)p_mag(HCP(g)))*nd_scale;
1750:
1751: sugar0 = sugar = SG(g);
1752: n = NV(g);
1753: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
1754: if ( d )
1755: for ( tail = BDY(d); NEXT(tail); tail = NEXT(tail) );
1756: sig = g->sig;
1757: for ( ; g; ) {
1758: index = ndl_find_reducer_s(HDL(g),sig);
1759: if ( index >= 0 && index < nd_psn ) {
1760: // reducer found
1761: h = nd_psh[index];
1762: ndl_sub(HDL(g),DL(h),DL(mul));
1763: if ( ndl_check_bound2(index,DL(mul)) ) {
1764: nd_free(g); nd_free(d);
1765: return 0;
1766: }
1767: p = ps[index];
1768: /* d+g -> div*(d+g)+mul*p */
1769: g = nd_reduce2(mod,d,g,p,mul,0,&div);
1770: sugar = MAX(sugar,SG(p)+TD(DL(mul)));
1771: if ( !mod && g && ((double)(p_mag(HCP(g))) > hmag) ) {
1772: hg = HCU(g);
1773: nd_removecont2(d,g);
1774: hmag = ((double)p_mag(HCP(g)))*nd_scale;
1775: }
1776: } else if ( index == -1 ) {
1777: // singular top reducible
1778: return -1;
1779: } else if ( !full ) {
1780: *rp = g;
1781: g->sig = sig;
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: if ( d ) {
1791: NEXT(tail)=m; tail=m; LEN(d)++;
1792: } else {
1793: MKND(n,m,1,d); tail = BDY(d);
1794: }
1795: }
1796: }
1797: if ( d ) {
1798: SG(d) = sugar;
1799: d->sig = sig;
1800: }
1801: *rp = d;
1802: return 1;
1803: }
1804:
1.1 noro 1805: int nd_nf_pbucket(int mod,ND g,NDV *ps,int full,ND *rp)
1806: {
1807: int hindex,index;
1808: NDV p;
1809: ND u,d,red;
1810: NODE l;
1811: NM mul,m,mrd,tail;
1812: int sugar,psugar,n,h_reducible;
1813: PGeoBucket bucket;
1814: int c,c1,c2;
1815: Z cg,cred,gcd,zzz;
1816: RHist h;
1817: double hmag,gmag;
1818: int count = 0;
1819: int hcount = 0;
1820:
1821: if ( !g ) {
1822: *rp = 0;
1823: return 1;
1824: }
1825: sugar = SG(g);
1826: n = NV(g);
1.6 noro 1827: if ( !mod ) hmag = ((double)p_mag((P)HCZ(g)))*nd_scale;
1.1 noro 1828: bucket = create_pbucket();
1829: add_pbucket(mod,bucket,g);
1830: d = 0;
1831: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
1832: while ( 1 ) {
1833: if ( mod > 0 || mod == -1 )
1834: hindex = head_pbucket(mod,bucket);
1835: else if ( mod == -2 )
1836: hindex = head_pbucket_lf(bucket);
1837: else
1838: hindex = head_pbucket_q(bucket);
1839: if ( hindex < 0 ) {
1840: if ( DP_Print > 3 ) printf("(%d %d)",count,hcount);
1841: if ( d ) SG(d) = sugar;
1842: *rp = d;
1843: return 1;
1844: }
1845: g = bucket->body[hindex];
1846: index = ndl_find_reducer(HDL(g));
1847: if ( index >= 0 ) {
1848: count++;
1849: if ( !d ) hcount++;
1850: h = nd_psh[index];
1851: ndl_sub(HDL(g),DL(h),DL(mul));
1852: if ( ndl_check_bound2(index,DL(mul)) ) {
1853: nd_free(d);
1854: free_pbucket(bucket);
1855: *rp = 0;
1856: return 0;
1857: }
1858: p = ps[index];
1859: if ( mod == -1 )
1860: CM(mul) = _mulsf(_invsf(HCM(p)),_chsgnsf(HCM(g)));
1861: else if ( mod == -2 ) {
1862: Z inv,t;
1863: divlf(ONE,HCZ(p),&inv);
1864: chsgnlf(HCZ(g),&t);
1865: mullf(inv,t,&CZ(mul));
1866: } else if ( mod ) {
1867: c1 = invm(HCM(p),mod); c2 = mod-HCM(g);
1868: DMAR(c1,c2,0,mod,c); CM(mul) = c;
1869: } else {
1.6 noro 1870: igcd_cofactor(HCZ(g),HCZ(p),&gcd,&cg,&cred);
1871: chsgnz(cg,&CZ(mul));
1.1 noro 1872: nd_mul_c_q(d,(P)cred);
1873: mulq_pbucket(bucket,cred);
1874: g = bucket->body[hindex];
1.6 noro 1875: gmag = (double)p_mag((P)HCZ(g));
1.1 noro 1876: }
1877: red = ndv_mul_nm(mod,mul,p);
1878: bucket->body[hindex] = nd_remove_head(g);
1879: red = nd_remove_head(red);
1880: add_pbucket(mod,bucket,red);
1881: psugar = SG(p)+TD(DL(mul));
1882: sugar = MAX(sugar,psugar);
1883: if ( !mod && hmag && (gmag > hmag) ) {
1884: g = normalize_pbucket(mod,bucket);
1885: if ( !g ) {
1886: if ( d ) SG(d) = sugar;
1887: *rp = d;
1888: return 1;
1889: }
1890: nd_removecont2(d,g);
1.6 noro 1891: hmag = ((double)p_mag((P)HCZ(g)))*nd_scale;
1.1 noro 1892: add_pbucket(mod,bucket,g);
1893: }
1894: } else if ( !full ) {
1895: g = normalize_pbucket(mod,bucket);
1896: if ( g ) SG(g) = sugar;
1897: *rp = g;
1898: return 1;
1899: } else {
1900: m = BDY(g);
1901: if ( NEXT(m) ) {
1902: BDY(g) = NEXT(m); NEXT(m) = 0; LEN(g)--;
1903: } else {
1904: FREEND(g); g = 0;
1905: }
1906: bucket->body[hindex] = g;
1907: NEXT(m) = 0;
1908: if ( d ) {
1909: NEXT(tail)=m; tail=m; LEN(d)++;
1910: } else {
1911: MKND(n,m,1,d); tail = BDY(d);
1912: }
1913: }
1914: }
1915: }
1916:
1.25 ! noro 1917: int nd_nf_pbucket_s(int mod,ND g,NDV *ps,int full,ND *rp)
! 1918: {
! 1919: int hindex,index;
! 1920: NDV p;
! 1921: ND u,d,red;
! 1922: NODE l;
! 1923: NM mul,m,mrd,tail;
! 1924: int sugar,psugar,n,h_reducible;
! 1925: PGeoBucket bucket;
! 1926: int c,c1,c2;
! 1927: Z cg,cred,gcd,zzz;
! 1928: RHist h;
! 1929: double hmag,gmag;
! 1930: int count = 0;
! 1931: int hcount = 0;
! 1932: SIG sig;
! 1933:
! 1934: if ( !g ) {
! 1935: *rp = 0;
! 1936: return 1;
! 1937: }
! 1938: sugar = SG(g);
! 1939: n = NV(g);
! 1940: if ( !mod ) hmag = ((double)p_mag((P)HCZ(g)))*nd_scale;
! 1941: bucket = create_pbucket();
! 1942: add_pbucket(mod,bucket,g);
! 1943: d = 0;
! 1944: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
! 1945: sig = g->sig;
! 1946: while ( 1 ) {
! 1947: if ( mod > 0 || mod == -1 )
! 1948: hindex = head_pbucket(mod,bucket);
! 1949: else if ( mod == -2 )
! 1950: hindex = head_pbucket_lf(bucket);
! 1951: else
! 1952: hindex = head_pbucket_q(bucket);
! 1953: if ( hindex < 0 ) {
! 1954: if ( DP_Print > 3 ) printf("(%d %d)",count,hcount);
! 1955: if ( d ) {
! 1956: SG(d) = sugar;
! 1957: d->sig = sig;
! 1958: }
! 1959: *rp = d;
! 1960: return 1;
! 1961: }
! 1962: g = bucket->body[hindex];
! 1963: index = ndl_find_reducer_s(HDL(g),sig);
! 1964: if ( index >= 0 && index < nd_psn ) {
! 1965: count++;
! 1966: if ( !d ) hcount++;
! 1967: h = nd_psh[index];
! 1968: ndl_sub(HDL(g),DL(h),DL(mul));
! 1969: if ( ndl_check_bound2(index,DL(mul)) ) {
! 1970: nd_free(d);
! 1971: free_pbucket(bucket);
! 1972: *rp = 0;
! 1973: return 0;
! 1974: }
! 1975: p = ps[index];
! 1976: if ( mod == -1 )
! 1977: CM(mul) = _mulsf(_invsf(HCM(p)),_chsgnsf(HCM(g)));
! 1978: else if ( mod == -2 ) {
! 1979: Z inv,t;
! 1980: divlf(ONE,HCZ(p),&inv);
! 1981: chsgnlf(HCZ(g),&t);
! 1982: mullf(inv,t,&CZ(mul));
! 1983: } else if ( mod ) {
! 1984: c1 = invm(HCM(p),mod); c2 = mod-HCM(g);
! 1985: DMAR(c1,c2,0,mod,c); CM(mul) = c;
! 1986: } else {
! 1987: igcd_cofactor(HCZ(g),HCZ(p),&gcd,&cg,&cred);
! 1988: chsgnz(cg,&CZ(mul));
! 1989: nd_mul_c_q(d,(P)cred);
! 1990: mulq_pbucket(bucket,cred);
! 1991: g = bucket->body[hindex];
! 1992: gmag = (double)p_mag((P)HCZ(g));
! 1993: }
! 1994: red = ndv_mul_nm(mod,mul,p);
! 1995: bucket->body[hindex] = nd_remove_head(g);
! 1996: red = nd_remove_head(red);
! 1997: add_pbucket(mod,bucket,red);
! 1998: psugar = SG(p)+TD(DL(mul));
! 1999: sugar = MAX(sugar,psugar);
! 2000: if ( !mod && hmag && (gmag > hmag) ) {
! 2001: g = normalize_pbucket(mod,bucket);
! 2002: if ( !g ) {
! 2003: if ( d ) {
! 2004: SG(d) = sugar;
! 2005: d->sig = sig;
! 2006: }
! 2007: *rp = d;
! 2008: return 1;
! 2009: }
! 2010: nd_removecont2(d,g);
! 2011: hmag = ((double)p_mag((P)HCZ(g)))*nd_scale;
! 2012: add_pbucket(mod,bucket,g);
! 2013: }
! 2014: } else if ( index == -1 ) {
! 2015: // singular top reducible
! 2016: return -1;
! 2017: } else if ( !full ) {
! 2018: g = normalize_pbucket(mod,bucket);
! 2019: if ( g ) {
! 2020: SG(g) = sugar;
! 2021: g->sig = sig;
! 2022: }
! 2023: *rp = g;
! 2024: return 1;
! 2025: } else {
! 2026: m = BDY(g);
! 2027: if ( NEXT(m) ) {
! 2028: BDY(g) = NEXT(m); NEXT(m) = 0; LEN(g)--;
! 2029: } else {
! 2030: FREEND(g); g = 0;
! 2031: }
! 2032: bucket->body[hindex] = g;
! 2033: NEXT(m) = 0;
! 2034: if ( d ) {
! 2035: NEXT(tail)=m; tail=m; LEN(d)++;
! 2036: } else {
! 2037: MKND(n,m,1,d); tail = BDY(d);
! 2038: }
! 2039: }
! 2040: }
! 2041: }
! 2042:
1.1 noro 2043: /* input : list of NDV, cand : list of NDV */
2044:
2045: int ndv_check_membership(int m,NODE input,int obpe,int oadv,EPOS oepos,NODE cand)
2046: {
2047: int n,i,stat;
2048: ND nf,d;
2049: NDV r;
2050: NODE t,s;
2051: union oNDC dn;
2052: Z q;
2053: LIST list;
2054:
1.24 noro 2055: ndv_setup(m,0,cand,nd_gentrace?1:0,1,0);
1.1 noro 2056: n = length(cand);
2057:
2058: if ( nd_gentrace ) { nd_alltracelist = 0; nd_tracelist = 0; }
2059: /* membercheck : list is a subset of Id(cand) ? */
2060: for ( t = input, i = 0; t; t = NEXT(t), i++ ) {
2061: again:
2062: nd_tracelist = 0;
2063: if ( nd_bpe > obpe )
2064: r = ndv_dup_realloc((NDV)BDY(t),obpe,oadv,oepos);
2065: else
2066: r = (NDV)BDY(t);
2067: #if 0
2068: // moved to nd_f4_lf_trace()
2069: if ( m == -2 ) ndv_mod(m,r);
2070: #endif
2071: d = ndvtond(m,r);
1.6 noro 2072: stat = nd_nf(m,0,d,nd_ps,0,&nf);
1.1 noro 2073: if ( !stat ) {
2074: nd_reconstruct(0,0);
2075: goto again;
2076: } else if ( nf ) return 0;
2077: if ( nd_gentrace ) {
2078: nd_tracelist = reverse_node(nd_tracelist);
2079: MKLIST(list,nd_tracelist);
1.6 noro 2080: STOZ(i,q); s = mknode(2,q,list); MKLIST(list,s);
1.1 noro 2081: MKNODE(s,list,nd_alltracelist);
2082: nd_alltracelist = s; nd_tracelist = 0;
2083: }
2084: if ( DP_Print ) { printf("."); fflush(stdout); }
2085: }
2086: if ( DP_Print ) { printf("\n"); }
2087: return 1;
2088: }
2089:
2090: ND nd_remove_head(ND p)
2091: {
2092: NM m;
2093:
2094: m = BDY(p);
2095: if ( !NEXT(m) ) {
2096: FREEND(p); p = 0;
2097: } else {
2098: BDY(p) = NEXT(m); LEN(p)--;
2099: }
2100: FREENM(m);
2101: return p;
2102: }
2103:
2104: ND nd_separate_head(ND p,ND *head)
2105: {
2106: NM m,m0;
2107: ND r;
2108:
2109: m = BDY(p);
2110: if ( !NEXT(m) ) {
2111: *head = p; p = 0;
2112: } else {
2113: m0 = m;
2114: BDY(p) = NEXT(m); LEN(p)--;
2115: NEXT(m0) = 0;
2116: MKND(NV(p),m0,1,r);
2117: *head = r;
2118: }
2119: return p;
2120: }
2121:
2122: PGeoBucket create_pbucket()
2123: {
2124: PGeoBucket g;
2125:
2126: g = CALLOC(1,sizeof(struct oPGeoBucket));
2127: g->m = -1;
2128: return g;
2129: }
2130:
2131: void free_pbucket(PGeoBucket b) {
2132: int i;
2133:
2134: for ( i = 0; i <= b->m; i++ )
2135: if ( b->body[i] ) {
2136: nd_free(b->body[i]);
2137: b->body[i] = 0;
2138: }
2139: GCFREE(b);
2140: }
2141:
2142: void add_pbucket_symbolic(PGeoBucket g,ND d)
2143: {
2144: int l,i,k,m;
2145:
2146: if ( !d )
2147: return;
2148: l = LEN(d);
2149: for ( k = 0, m = 1; l > m; k++, m <<= 1 );
2150: /* 2^(k-1) < l <= 2^k (=m) */
2151: d = nd_merge(g->body[k],d);
2152: for ( ; d && LEN(d) > m; k++, m <<= 1 ) {
2153: g->body[k] = 0;
2154: d = nd_merge(g->body[k+1],d);
2155: }
2156: g->body[k] = d;
2157: g->m = MAX(g->m,k);
2158: }
2159:
2160: void add_pbucket(int mod,PGeoBucket g,ND d)
2161: {
2162: int l,i,k,m;
2163:
2164: if ( !d )
2165: return;
2166: l = LEN(d);
2167: for ( k = 0, m = 1; l > m; k++, m <<= 1 );
2168: /* 2^(k-1) < l <= 2^k (=m) */
2169: d = nd_add(mod,g->body[k],d);
2170: for ( ; d && LEN(d) > m; k++, m <<= 1 ) {
2171: g->body[k] = 0;
2172: d = nd_add(mod,g->body[k+1],d);
2173: }
2174: g->body[k] = d;
2175: g->m = MAX(g->m,k);
2176: }
2177:
2178: void mulq_pbucket(PGeoBucket g,Z c)
2179: {
2180: int k;
2181:
2182: for ( k = 0; k <= g->m; k++ )
2183: nd_mul_c_q(g->body[k],(P)c);
2184: }
2185:
2186: NM remove_head_pbucket_symbolic(PGeoBucket g)
2187: {
2188: int j,i,k,c;
2189: NM head;
2190:
2191: k = g->m;
2192: j = -1;
2193: for ( i = 0; i <= k; i++ ) {
2194: if ( !g->body[i] ) continue;
2195: if ( j < 0 ) j = i;
2196: else {
2197: c = DL_COMPARE(HDL(g->body[i]),HDL(g->body[j]));
2198: if ( c > 0 )
2199: j = i;
2200: else if ( c == 0 )
2201: g->body[i] = nd_remove_head(g->body[i]);
2202: }
2203: }
2204: if ( j < 0 ) return 0;
2205: else {
2206: head = BDY(g->body[j]);
2207: if ( !NEXT(head) ) {
2208: FREEND(g->body[j]);
2209: g->body[j] = 0;
2210: } else {
2211: BDY(g->body[j]) = NEXT(head);
2212: LEN(g->body[j])--;
2213: }
2214: return head;
2215: }
2216: }
2217:
2218: int head_pbucket(int mod,PGeoBucket g)
2219: {
2220: int j,i,c,k,nv,sum;
2221: UINT *di,*dj;
2222: ND gi,gj;
2223:
2224: k = g->m;
2225: while ( 1 ) {
2226: j = -1;
2227: for ( i = 0; i <= k; i++ ) {
2228: if ( !(gi = g->body[i]) )
2229: continue;
2230: if ( j < 0 ) {
2231: j = i;
2232: gj = g->body[j];
2233: dj = HDL(gj);
2234: sum = HCM(gj);
2235: } else {
2236: c = DL_COMPARE(HDL(gi),dj);
2237: if ( c > 0 ) {
2238: if ( sum ) HCM(gj) = sum;
2239: else g->body[j] = nd_remove_head(gj);
2240: j = i;
2241: gj = g->body[j];
2242: dj = HDL(gj);
2243: sum = HCM(gj);
2244: } else if ( c == 0 ) {
2245: if ( mod == -1 )
2246: sum = _addsf(sum,HCM(gi));
2247: else {
2248: sum = sum+HCM(gi)-mod;
2249: if ( sum < 0 ) sum += mod;
2250: }
2251: g->body[i] = nd_remove_head(gi);
2252: }
2253: }
2254: }
2255: if ( j < 0 ) return -1;
2256: else if ( sum ) {
2257: HCM(gj) = sum;
2258: return j;
2259: } else
2260: g->body[j] = nd_remove_head(gj);
2261: }
2262: }
2263:
2264: int head_pbucket_q(PGeoBucket g)
2265: {
2266: int j,i,c,k,nv;
2267: Z sum,t;
2268: ND gi,gj;
2269:
2270: k = g->m;
2271: while ( 1 ) {
2272: j = -1;
2273: for ( i = 0; i <= k; i++ ) {
2274: if ( !(gi = g->body[i]) ) continue;
2275: if ( j < 0 ) {
2276: j = i;
2277: gj = g->body[j];
1.6 noro 2278: sum = HCZ(gj);
1.1 noro 2279: } else {
2280: nv = NV(gi);
2281: c = DL_COMPARE(HDL(gi),HDL(gj));
2282: if ( c > 0 ) {
1.6 noro 2283: if ( sum ) HCZ(gj) = sum;
1.1 noro 2284: else g->body[j] = nd_remove_head(gj);
2285: j = i;
2286: gj = g->body[j];
1.6 noro 2287: sum = HCZ(gj);
1.1 noro 2288: } else if ( c == 0 ) {
1.6 noro 2289: addz(sum,HCZ(gi),&t);
1.1 noro 2290: sum = t;
2291: g->body[i] = nd_remove_head(gi);
2292: }
2293: }
2294: }
2295: if ( j < 0 ) return -1;
2296: else if ( sum ) {
1.6 noro 2297: HCZ(gj) = sum;
1.1 noro 2298: return j;
2299: } else
2300: g->body[j] = nd_remove_head(gj);
2301: }
2302: }
2303:
2304: int head_pbucket_lf(PGeoBucket g)
2305: {
2306: int j,i,c,k,nv;
2307: Z sum,t;
2308: ND gi,gj;
2309:
2310: k = g->m;
2311: while ( 1 ) {
2312: j = -1;
2313: for ( i = 0; i <= k; i++ ) {
2314: if ( !(gi = g->body[i]) ) continue;
2315: if ( j < 0 ) {
2316: j = i;
2317: gj = g->body[j];
2318: sum = HCZ(gj);
2319: } else {
2320: nv = NV(gi);
2321: c = DL_COMPARE(HDL(gi),HDL(gj));
2322: if ( c > 0 ) {
2323: if ( sum ) HCZ(gj) = sum;
2324: else g->body[j] = nd_remove_head(gj);
2325: j = i;
2326: gj = g->body[j];
2327: sum = HCZ(gj);
2328: } else if ( c == 0 ) {
2329: addlf(sum,HCZ(gi),&t);
2330: sum = t;
2331: g->body[i] = nd_remove_head(gi);
2332: }
2333: }
2334: }
2335: if ( j < 0 ) return -1;
2336: else if ( sum ) {
2337: HCZ(gj) = sum;
2338: return j;
2339: } else
2340: g->body[j] = nd_remove_head(gj);
2341: }
2342: }
2343:
2344: ND normalize_pbucket(int mod,PGeoBucket g)
2345: {
2346: int i;
2347: ND r,t;
2348:
2349: r = 0;
2350: for ( i = 0; i <= g->m; i++ ) {
2351: r = nd_add(mod,r,g->body[i]);
2352: g->body[i] = 0;
2353: }
2354: g->m = -1;
2355: return r;
2356: }
2357:
2358: #if 0
2359: void register_hcf(NDV p)
2360: {
2361: DCP dc,t;
2362: P hc,h;
2363: int c;
2364: NODE l,l1,prev;
2365:
2366: hc = p->body->c.p;
2367: if ( !nd_vc || NUM(hc) ) return;
2368: fctrp(nd_vc,hc,&dc);
2369: for ( t = dc; t; t = NEXT(t) ) {
2370: h = t->c;
2371: if ( NUM(h) ) continue;
2372: for ( prev = 0, l = nd_hcf; l; prev = l, l = NEXT(l) ) {
2373: c = compp(nd_vc,h,(P)BDY(l));
2374: if ( c >= 0 ) break;
2375: }
2376: if ( !l || c > 0 ) {
2377: MKNODE(l1,h,l);
2378: if ( !prev )
2379: nd_hcf = l1;
2380: else
2381: NEXT(prev) = l1;
2382: }
2383: }
2384: }
2385: #else
2386: void register_hcf(NDV p)
2387: {
2388: DCP dc,t;
2389: P hc,h,q;
2390: Q dmy;
2391: int c;
2392: NODE l,l1,prev;
2393:
2394: hc = p->body->c.p;
2395: if ( NUM(hc) ) return;
2396: ptozp(hc,1,&dmy,&h);
2397: #if 1
2398: for ( l = nd_hcf; l; l = NEXT(l) ) {
2399: while ( 1 ) {
2400: if ( divtpz(nd_vc,h,(P)BDY(l),&q) ) h = q;
2401: else break;
2402: }
2403: }
2404: if ( NUM(h) ) return;
2405: #endif
2406: for ( prev = 0, l = nd_hcf; l; prev = l, l = NEXT(l) ) {
2407: c = compp(nd_vc,h,(P)BDY(l));
2408: if ( c >= 0 ) break;
2409: }
2410: if ( !l || c > 0 ) {
2411: MKNODE(l1,h,l);
2412: if ( !prev )
2413: nd_hcf = l1;
2414: else
2415: NEXT(prev) = l1;
2416: }
2417: }
2418: #endif
2419:
2420: int do_diagonalize(int sugar,int m)
2421: {
1.6 noro 2422: int i,nh,stat;
2423: NODE r,g,t;
2424: ND h,nf,s,head;
2425: NDV nfv;
2426: Q q;
2427: P nm,nmp,dn,mnp,dnp,cont,cont1;
2428: union oNDC hc;
2429: NODE node;
2430: LIST l;
2431: Z iq;
1.1 noro 2432:
1.6 noro 2433: for ( i = nd_psn-1; i >= 0 && SG(nd_psh[i]) == sugar; i-- ) {
2434: if ( nd_gentrace ) {
2435: /* Trace = [1,index,1,1] */
2436: STOZ(i,iq); node = mknode(4,ONE,iq,ONE,ONE);
2437: MKLIST(l,node); MKNODE(nd_tracelist,l,0);
2438: }
2439: if ( nd_demand )
2440: nfv = ndv_load(i);
2441: else
2442: nfv = nd_ps[i];
2443: s = ndvtond(m,nfv);
2444: s = nd_separate_head(s,&head);
2445: stat = nd_nf(m,head,s,nd_ps,1,&nf);
2446: if ( !stat ) return 0;
2447: ndv_free(nfv);
2448: hc = HCU(nf); nd_removecont(m,nf);
2449: /* exact division */
2450: cont = ndc_div(m,hc,HCU(nf));
1.1 noro 2451: if ( nd_gentrace ) finalize_tracelist(i,cont);
1.6 noro 2452: nfv = ndtondv(m,nf);
2453: nd_free(nf);
2454: nd_bound[i] = ndv_compute_bound(nfv);
2455: if ( !m ) register_hcf(nfv);
2456: if ( nd_demand ) {
2457: ndv_save(nfv,i);
2458: ndv_free(nfv);
2459: } else
2460: nd_ps[i] = nfv;
2461: }
2462: return 1;
1.1 noro 2463: }
2464:
2465: LIST compute_splist()
2466: {
2467: NODE g,tn0,tn,node;
2468: LIST l0;
2469: ND_pairs d,t;
2470: int i;
2471: Z i1,i2;
2472:
2473: g = 0; d = 0;
2474: for ( i = 0; i < nd_psn; i++ ) {
2475: d = update_pairs(d,g,i,0);
2476: g = update_base(g,i);
2477: }
2478: for ( t = d, tn0 = 0; t; t = NEXT(t) ) {
2479: NEXTNODE(tn0,tn);
1.6 noro 2480: STOZ(t->i1,i1); STOZ(t->i2,i2);
1.1 noro 2481: node = mknode(2,i1,i2); MKLIST(l0,node);
2482: BDY(tn) = l0;
2483: }
2484: if ( tn0 ) NEXT(tn) = 0; MKLIST(l0,tn0);
2485: return l0;
2486: }
2487:
2488: /* return value = 0 => input is not a GB */
2489:
2490: NODE nd_gb(int m,int ishomo,int checkonly,int gensyz,int **indp)
2491: {
1.6 noro 2492: int i,nh,sugar,stat;
2493: NODE r,g,t;
2494: ND_pairs d;
2495: ND_pairs l;
2496: ND h,nf,s,head,nf1;
2497: NDV nfv;
2498: Z q;
2499: union oNDC dn,hc;
2500: int diag_count = 0;
2501: P cont;
2502: LIST list;
2503:
1.11 noro 2504: Nnd_add = 0;
1.6 noro 2505: g = 0; d = 0;
2506: for ( i = 0; i < nd_psn; i++ ) {
2507: d = update_pairs(d,g,i,gensyz);
2508: g = update_base(g,i);
2509: }
2510: sugar = 0;
2511: while ( d ) {
1.1 noro 2512: again:
1.6 noro 2513: l = nd_minp(d,&d);
2514: if ( MaxDeg > 0 && SG(l) > MaxDeg ) break;
2515: if ( SG(l) != sugar ) {
2516: if ( ishomo ) {
2517: diag_count = 0;
2518: stat = do_diagonalize(sugar,m);
1.1 noro 2519: if ( !stat ) {
1.6 noro 2520: NEXT(l) = d; d = l;
2521: d = nd_reconstruct(0,d);
2522: goto again;
1.1 noro 2523: }
1.6 noro 2524: }
2525: sugar = SG(l);
2526: if ( DP_Print ) fprintf(asir_out,"%d",sugar);
2527: }
2528: stat = nd_sp(m,0,l,&h);
2529: if ( !stat ) {
2530: NEXT(l) = d; d = l;
2531: d = nd_reconstruct(0,d);
2532: goto again;
2533: }
1.1 noro 2534: #if USE_GEOBUCKET
1.6 noro 2535: stat = (m&&!nd_gentrace)?nd_nf_pbucket(m,h,nd_ps,!Top,&nf)
2536: :nd_nf(m,0,h,nd_ps,!Top,&nf);
1.1 noro 2537: #else
1.6 noro 2538: stat = nd_nf(m,0,h,nd_ps,!Top,&nf);
1.1 noro 2539: #endif
1.6 noro 2540: if ( !stat ) {
2541: NEXT(l) = d; d = l;
2542: d = nd_reconstruct(0,d);
2543: goto again;
2544: } else if ( nf ) {
2545: if ( checkonly || gensyz ) return 0;
1.1 noro 2546: if ( nd_newelim ) {
2547: if ( nd_module ) {
2548: if ( MPOS(HDL(nf)) > 1 ) return 0;
2549: } else if ( !(HDL(nf)[nd_exporigin] & nd_mask[0]) ) return 0;
2550: }
1.6 noro 2551: if ( DP_Print ) { printf("+"); fflush(stdout); }
2552: hc = HCU(nf);
2553: nd_removecont(m,nf);
2554: if ( !m && nd_nalg ) {
2555: nd_monic(0,&nf);
2556: nd_removecont(m,nf);
2557: }
2558: if ( nd_gentrace ) {
2559: /* exact division */
1.1 noro 2560: cont = ndc_div(m,hc,HCU(nf));
2561: if ( m || !UNIQ(cont) ) {
1.6 noro 2562: t = mknode(4,NULLP,NULLP,NULLP,cont);
2563: MKLIST(list,t); MKNODE(t,list,nd_tracelist);
1.1 noro 2564: nd_tracelist = t;
2565: }
2566: }
1.6 noro 2567: nfv = ndtondv(m,nf); nd_free(nf);
1.24 noro 2568: nh = ndv_newps(m,nfv,0);
1.6 noro 2569: if ( !m && (ishomo && ++diag_count == diag_period) ) {
2570: diag_count = 0;
2571: stat = do_diagonalize(sugar,m);
2572: if ( !stat ) {
2573: NEXT(l) = d; d = l;
2574: d = nd_reconstruct(1,d);
2575: goto again;
1.1 noro 2576: }
1.6 noro 2577: }
2578: d = update_pairs(d,g,nh,0);
2579: g = update_base(g,nh);
2580: FREENDP(l);
2581: } else {
2582: if ( nd_gentrace && gensyz ) {
2583: nd_tracelist = reverse_node(nd_tracelist);
2584: MKLIST(list,nd_tracelist);
2585: STOZ(-1,q); t = mknode(2,q,list); MKLIST(list,t);
2586: MKNODE(t,list,nd_alltracelist);
2587: nd_alltracelist = t; nd_tracelist = 0;
2588: }
2589: if ( DP_Print ) { printf("."); fflush(stdout); }
2590: FREENDP(l);
2591: }
2592: }
2593: conv_ilist(nd_demand,0,g,indp);
1.11 noro 2594: if ( !checkonly && DP_Print ) { printf("nd_gb done. Number of nd_add=%d\n",Nnd_add); fflush(stdout); }
1.1 noro 2595: return g;
2596: }
2597:
1.24 noro 2598: ND_pairs update_pairs_s(ND_pairs d,NODE g,int t,NODE syz);
2599: ND_pairs nd_newpairs_s( NODE g, int t ,NODE syz);
2600:
2601: int nd_nf_pbucket_s(int mod,ND g,NDV *ps,int full,ND *nf);
2602: int nd_nf_s(int mod,ND d,ND g,NDV *ps,int full,ND *nf);
2603:
2604: void _copydl(int n,DL d1,DL d2);
2605: void _subfromdl(int n,DL d1,DL d2);
2606: extern int (*cmpdl)(int n,DL d1,DL d2);
2607:
2608: NODE insert_sig(NODE l,SIG s)
2609: {
2610: int pos;
2611: DL sig;
2612: struct oNODE root;
2613: NODE p,prev,r;
2614: SIG t;
2615:
2616: pos = s->pos; sig = DL(s);
2617: root.next = l; prev = &root;
2618: for ( p = l; p; p = p->next ) {
2619: t = (SIG)p->body;
2620: if ( t->pos == pos ) {
2621: if ( _dl_redble(DL(t),sig,nd_nvar) )
2622: return root.next;
2623: else if ( _dl_redble(sig,DL(t),nd_nvar) )
2624: // remove p
2625: prev->next = p->next;
2626: } else
2627: prev = p;
2628: }
2629: NEWNODE(r); r->body = (pointer)s;
2630: r->next = root.next;
2631: return r;
2632: }
2633:
2634: ND_pairs remove_spair_s(ND_pairs d,SIG sig)
2635: {
2636: struct oND_pairs root;
2637: ND_pairs prev,p;
2638: SIG spsig;
2639:
2640: root.next = d;
2641: prev = &root; p = d;
2642: while ( p ) {
2643: spsig = p->sig;
2644: if ( sig->pos == spsig->pos && _dl_redble(DL(sig),DL(spsig),nd_nvar) )
2645: // remove p
2646: prev->next = p->next;
2647: else
2648: prev = p;
2649: p = p->next;
2650: }
2651: return (ND_pairs)root.next;
2652: }
2653:
2654: NODE nd_sba_buch(int m,int ishomo,int **indp)
2655: {
2656: int i,nh,sugar,stat;
2657: NODE r,g,t;
2658: ND_pairs d;
2659: ND_pairs l;
2660: ND h,nf,s,head,nf1;
2661: NDV nfv;
2662: Z q;
2663: union oNDC dn,hc;
2664: P cont;
2665: LIST list;
2666: SIG sig;
2667: NODE syzlist;
2668: static int wpd;
2669: static SIG quo,mul;
2670: static DL lcm;
2671:
2672: syzlist = 0;
2673: Nnd_add = 0;
2674: g = 0; d = 0;
2675: for ( i = 0; i < nd_psn; i++ ) {
2676: d = update_pairs_s(d,g,i,0);
2677: g = append_one(g,i);
2678: }
2679: sugar = 0;
2680: while ( d ) {
2681: again:
2682: l = d; d = d->next;
2683: sig = l->sig;
2684: if ( wpd < nd_wpd ) {
2685: wpd = nd_wpd;
2686: NEWSIG(quo);
2687: NEWSIG(mul);
2688: NEWDL(lcm,nd_nvar);
2689: }
2690: _ndltodl(l->lcm,lcm);
2691: for ( i = 0; i < nd_psn; i++ ) {
2692: if ( sig->pos == nd_psh[i]->sig->pos &&
2693: _dl_redble(DL(nd_psh[i]->sig),DL(sig),nd_nvar) ) {
2694: _copydl(nd_nvar,DL(sig),DL(quo));
2695: _subfromdl(nd_nvar,DL(nd_psh[i]->sig),DL(quo));
2696: _ndltodl(DL(nd_psh[i]),DL(mul));
2697: _addtodl(nd_nvar,DL(quo),DL(mul));
2698: if ( (*cmpdl)(nd_nvar,lcm,DL(mul)) > 0 )
2699: break;
2700: }
2701: }
2702: if ( i < nd_psn ) {
2703: if ( DP_Print ) fprintf(asir_out,"M");
2704: continue;
2705: }
2706: if ( SG(l) != sugar ) {
2707: sugar = SG(l);
2708: if ( DP_Print ) fprintf(asir_out,"%d",sugar);
2709: }
2710: stat = nd_sp(m,0,l,&h);
2711: if ( !stat ) {
2712: NEXT(l) = d; d = l;
2713: d = nd_reconstruct(0,d);
2714: goto again;
2715: }
1.25 ! noro 2716: #if USE_GEOBUCKET
1.24 noro 2717: stat = m?nd_nf_pbucket_s(m,h,nd_ps,!Top,&nf):nd_nf_s(m,0,h,nd_ps,!Top,&nf);
2718: #else
2719: stat = nd_nf_s(m,0,h,nd_ps,!Top,&nf);
2720: #endif
2721: if ( !stat ) {
2722: NEXT(l) = d; d = l;
2723: d = nd_reconstruct(0,d);
2724: goto again;
2725: } else if ( stat == -1 ) {
2726: if ( DP_Print ) { printf("S"); fflush(stdout); }
2727: } else if ( nf ) {
2728: if ( DP_Print ) { printf("+"); fflush(stdout); }
2729: hc = HCU(nf);
2730: nd_removecont(m,nf);
2731: nfv = ndtondv(m,nf); nd_free(nf);
2732: nh = ndv_newps(m,nfv,0);
2733: d = update_pairs_s(d,g,nh,syzlist);
2734: g = append_one(g,nh);
2735: FREENDP(l);
2736: } else {
2737: // syzygy
2738: d = remove_spair_s(d,sig);
2739: syzlist = insert_sig(syzlist,sig);
2740: if ( DP_Print ) { printf("."); fflush(stdout); }
2741: FREENDP(l);
2742: }
2743: }
2744: conv_ilist(nd_demand,0,g,indp);
2745: if ( DP_Print ) { printf("nd_sba done. Number of nd_add=%d\n",Nnd_add); fflush(stdout); }
2746: return g;
2747: }
2748:
1.1 noro 2749: /* splist = [[i1,i2],...] */
2750:
2751: int check_splist(int m,NODE splist)
2752: {
2753: NODE t,p;
2754: ND_pairs d,r,l;
2755: int stat;
2756: ND h,nf;
2757:
2758: for ( d = 0, t = splist; t; t = NEXT(t) ) {
2759: p = BDY((LIST)BDY(t));
1.6 noro 2760: NEXTND_pairs(d,r);
2761: r->i1 = ZTOS((Q)ARG0(p)); r->i2 = ZTOS((Q)ARG1(p));
2762: ndl_lcm(DL(nd_psh[r->i1]),DL(nd_psh[r->i2]),r->lcm);
1.1 noro 2763: SG(r) = TD(LCM(r)); /* XXX */
2764: }
2765: if ( d ) NEXT(r) = 0;
2766:
1.6 noro 2767: while ( d ) {
1.1 noro 2768: again:
1.6 noro 2769: l = nd_minp(d,&d);
2770: stat = nd_sp(m,0,l,&h);
2771: if ( !stat ) {
2772: NEXT(l) = d; d = l;
2773: d = nd_reconstruct(0,d);
2774: goto again;
2775: }
2776: stat = nd_nf(m,0,h,nd_ps,!Top,&nf);
2777: if ( !stat ) {
2778: NEXT(l) = d; d = l;
2779: d = nd_reconstruct(0,d);
2780: goto again;
2781: } else if ( nf ) return 0;
1.1 noro 2782: if ( DP_Print) { printf("."); fflush(stdout); }
1.6 noro 2783: }
1.1 noro 2784: if ( DP_Print) { printf("done.\n"); fflush(stdout); }
2785: return 1;
2786: }
2787:
2788: int check_splist_f4(int m,NODE splist)
2789: {
2790: UINT *s0vect;
1.6 noro 2791: PGeoBucket bucket;
1.1 noro 2792: NODE p,rp0,t;
2793: ND_pairs d,r,l,ll;
2794: int col,stat;
2795:
2796: for ( d = 0, t = splist; t; t = NEXT(t) ) {
2797: p = BDY((LIST)BDY(t));
1.6 noro 2798: NEXTND_pairs(d,r);
2799: r->i1 = ZTOS((Q)ARG0(p)); r->i2 = ZTOS((Q)ARG1(p));
2800: ndl_lcm(DL(nd_psh[r->i1]),DL(nd_psh[r->i2]),r->lcm);
1.1 noro 2801: SG(r) = TD(LCM(r)); /* XXX */
2802: }
2803: if ( d ) NEXT(r) = 0;
2804:
1.6 noro 2805: while ( d ) {
2806: l = nd_minsugarp(d,&d);
2807: bucket = create_pbucket();
2808: stat = nd_sp_f4(m,0,l,bucket);
2809: if ( !stat ) {
2810: for ( ll = l; NEXT(ll); ll = NEXT(ll) );
2811: NEXT(ll) = d; d = l;
2812: d = nd_reconstruct(0,d);
2813: continue;
2814: }
2815: if ( bucket->m < 0 ) continue;
2816: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
2817: if ( !col ) {
2818: for ( ll = l; NEXT(ll); ll = NEXT(ll) );
2819: NEXT(ll) = d; d = l;
2820: d = nd_reconstruct(0,d);
2821: continue;
1.1 noro 2822: }
1.6 noro 2823: if ( nd_f4_red(m,l,0,s0vect,col,rp0,0) ) return 0;
2824: }
2825: return 1;
1.1 noro 2826: }
2827:
2828: int do_diagonalize_trace(int sugar,int m)
2829: {
1.6 noro 2830: int i,nh,stat;
2831: NODE r,g,t;
2832: ND h,nf,nfq,s,head;
2833: NDV nfv,nfqv;
2834: Q q,den,num;
2835: union oNDC hc;
2836: NODE node;
2837: LIST l;
2838: Z iq;
2839: P cont,cont1;
1.1 noro 2840:
1.6 noro 2841: for ( i = nd_psn-1; i >= 0 && SG(nd_psh[i]) == sugar; i-- ) {
2842: if ( nd_gentrace ) {
2843: /* Trace = [1,index,1,1] */
2844: STOZ(i,iq); node = mknode(4,ONE,iq,ONE,ONE);
2845: MKLIST(l,node); MKNODE(nd_tracelist,l,0);
2846: }
2847: /* for nd_ps */
2848: s = ndvtond(m,nd_ps[i]);
2849: s = nd_separate_head(s,&head);
2850: stat = nd_nf_pbucket(m,s,nd_ps,1,&nf);
2851: if ( !stat ) return 0;
2852: nf = nd_add(m,head,nf);
2853: ndv_free(nd_ps[i]);
2854: nd_ps[i] = ndtondv(m,nf);
2855: nd_free(nf);
2856:
2857: /* for nd_ps_trace */
2858: if ( nd_demand )
2859: nfv = ndv_load(i);
2860: else
2861: nfv = nd_ps_trace[i];
2862: s = ndvtond(0,nfv);
2863: s = nd_separate_head(s,&head);
2864: stat = nd_nf(0,head,s,nd_ps_trace,1,&nf);
2865: if ( !stat ) return 0;
2866: ndv_free(nfv);
2867: hc = HCU(nf); nd_removecont(0,nf);
2868: /* exact division */
1.1 noro 2869: cont = ndc_div(0,hc,HCU(nf));
1.6 noro 2870: if ( nd_gentrace ) finalize_tracelist(i,cont);
2871: nfv = ndtondv(0,nf);
2872: nd_free(nf);
2873: nd_bound[i] = ndv_compute_bound(nfv);
2874: register_hcf(nfv);
2875: if ( nd_demand ) {
2876: ndv_save(nfv,i);
2877: ndv_free(nfv);
2878: } else
2879: nd_ps_trace[i] = nfv;
2880: }
2881: return 1;
1.1 noro 2882: }
2883:
2884: static struct oEGT eg_invdalg;
2885: struct oEGT eg_le;
2886:
2887: void nd_subst_vector(VL vl,P p,NODE subst,P *r)
2888: {
2889: NODE tn;
2890: P p1;
2891:
2892: for ( tn = subst; tn; tn = NEXT(NEXT(tn)) ) {
2893: substp(vl,p,BDY(tn),BDY(NEXT(tn)),&p1); p = p1;
2894: }
2895: *r = p;
2896: }
2897:
2898: NODE nd_gb_trace(int m,int ishomo,int **indp)
2899: {
1.6 noro 2900: int i,nh,sugar,stat;
2901: NODE r,g,t;
2902: ND_pairs d;
2903: ND_pairs l;
2904: ND h,nf,nfq,s,head;
2905: NDV nfv,nfqv;
2906: Z q,den,num;
2907: P hc;
2908: union oNDC dn,hnfq;
2909: struct oEGT eg_monic,egm0,egm1;
2910: int diag_count = 0;
2911: P cont;
2912: LIST list;
2913:
2914: init_eg(&eg_monic);
2915: init_eg(&eg_invdalg);
2916: init_eg(&eg_le);
2917: g = 0; d = 0;
2918: for ( i = 0; i < nd_psn; i++ ) {
2919: d = update_pairs(d,g,i,0);
2920: g = update_base(g,i);
2921: }
2922: sugar = 0;
2923: while ( d ) {
1.1 noro 2924: again:
1.6 noro 2925: l = nd_minp(d,&d);
2926: if ( MaxDeg > 0 && SG(l) > MaxDeg ) break;
2927: if ( SG(l) != sugar ) {
1.1 noro 2928: #if 1
1.6 noro 2929: if ( ishomo ) {
2930: if ( DP_Print > 2 ) fprintf(asir_out,"|");
2931: stat = do_diagonalize_trace(sugar,m);
2932: if ( DP_Print > 2 ) fprintf(asir_out,"|");
2933: diag_count = 0;
1.1 noro 2934: if ( !stat ) {
1.6 noro 2935: NEXT(l) = d; d = l;
2936: d = nd_reconstruct(1,d);
2937: goto again;
1.1 noro 2938: }
1.6 noro 2939: }
2940: #endif
2941: sugar = SG(l);
2942: if ( DP_Print ) fprintf(asir_out,"%d",sugar);
2943: }
2944: stat = nd_sp(m,0,l,&h);
2945: if ( !stat ) {
2946: NEXT(l) = d; d = l;
2947: d = nd_reconstruct(1,d);
2948: goto again;
2949: }
1.1 noro 2950: #if USE_GEOBUCKET
1.6 noro 2951: stat = nd_nf_pbucket(m,h,nd_ps,!Top,&nf);
1.1 noro 2952: #else
1.6 noro 2953: stat = nd_nf(m,0,h,nd_ps,!Top,&nf);
1.1 noro 2954: #endif
1.6 noro 2955: if ( !stat ) {
2956: NEXT(l) = d; d = l;
2957: d = nd_reconstruct(1,d);
2958: goto again;
2959: } else if ( nf ) {
2960: if ( nd_demand ) {
2961: nfqv = ndv_load(nd_psn);
2962: nfq = ndvtond(0,nfqv);
2963: } else
2964: nfq = 0;
2965: if ( !nfq ) {
2966: if ( !nd_sp(0,1,l,&h) || !nd_nf(0,0,h,nd_ps_trace,!Top,&nfq) ) {
2967: NEXT(l) = d; d = l;
2968: d = nd_reconstruct(1,d);
2969: goto again;
2970: }
2971: }
2972: if ( nfq ) {
2973: /* m|HC(nfq) => failure */
2974: if ( nd_vc ) {
2975: nd_subst_vector(nd_vc,HCP(nfq),nd_subst,&hc); q = (Z)hc;
2976: } else
2977: q = HCZ(nfq);
2978: if ( !remqi((Q)q,m) ) return 0;
2979:
2980: if ( DP_Print ) { printf("+"); fflush(stdout); }
2981: hnfq = HCU(nfq);
2982: if ( nd_nalg ) {
2983: /* m|DN(HC(nf)^(-1)) => failure */
2984: get_eg(&egm0);
2985: if ( !nd_monic(m,&nfq) ) return 0;
2986: get_eg(&egm1); add_eg(&eg_monic,&egm0,&egm1);
2987: nd_removecont(0,nfq); nfqv = ndtondv(0,nfq); nd_free(nfq);
2988: nfv = ndv_dup(0,nfqv); ndv_mod(m,nfv); nd_free(nf);
2989: } else {
2990: nd_removecont(0,nfq); nfqv = ndtondv(0,nfq); nd_free(nfq);
2991: nd_removecont(m,nf); nfv = ndtondv(m,nf); nd_free(nf);
2992: }
2993: if ( nd_gentrace ) {
2994: /* exact division */
2995: cont = ndc_div(0,hnfq,HCU(nfqv));
2996: if ( !UNIQ(cont) ) {
2997: t = mknode(4,NULLP,NULLP,NULLP,cont);
2998: MKLIST(list,t); MKNODE(t,list,nd_tracelist);
2999: nd_tracelist = t;
3000: }
3001: }
1.24 noro 3002: nh = ndv_newps(0,nfv,nfqv);
1.6 noro 3003: if ( ishomo && ++diag_count == diag_period ) {
3004: diag_count = 0;
3005: if ( DP_Print > 2 ) fprintf(asir_out,"|");
3006: stat = do_diagonalize_trace(sugar,m);
3007: if ( DP_Print > 2 ) fprintf(asir_out,"|");
3008: if ( !stat ) {
1.1 noro 3009: NEXT(l) = d; d = l;
3010: d = nd_reconstruct(1,d);
3011: goto again;
1.6 noro 3012: }
1.1 noro 3013: }
1.6 noro 3014: d = update_pairs(d,g,nh,0);
3015: g = update_base(g,nh);
3016: } else {
3017: if ( DP_Print ) { printf("*"); fflush(stdout); }
3018: }
3019: } else {
3020: if ( DP_Print ) { printf("."); fflush(stdout); }
1.1 noro 3021: }
1.6 noro 3022: FREENDP(l);
3023: }
3024: if ( nd_nalg ) {
3025: if ( DP_Print ) {
3026: print_eg("monic",&eg_monic);
3027: print_eg("invdalg",&eg_invdalg);
3028: print_eg("le",&eg_le);
1.1 noro 3029: }
1.6 noro 3030: }
1.1 noro 3031: conv_ilist(nd_demand,1,g,indp);
1.6 noro 3032: if ( DP_Print ) { printf("nd_gb_trace done.\n"); fflush(stdout); }
3033: return g;
1.1 noro 3034: }
3035:
3036: int ndv_compare(NDV *p1,NDV *p2)
3037: {
3038: return DL_COMPARE(HDL(*p1),HDL(*p2));
3039: }
3040:
3041: int ndv_compare_rev(NDV *p1,NDV *p2)
3042: {
3043: return -DL_COMPARE(HDL(*p1),HDL(*p2));
3044: }
3045:
3046: int ndvi_compare(NDVI p1,NDVI p2)
3047: {
3048: return DL_COMPARE(HDL(p1->p),HDL(p2->p));
3049: }
3050:
3051: int ndvi_compare_rev(NDVI p1,NDVI p2)
3052: {
3053: return -DL_COMPARE(HDL(p1->p),HDL(p2->p));
3054: }
3055:
3056: NODE ndv_reduceall(int m,NODE f)
3057: {
3058: int i,j,n,stat;
3059: ND nf,g,head;
3060: NODE t,a0,a;
3061: union oNDC dn;
3062: Q q,num,den;
3063: NODE node;
3064: LIST l;
3065: Z iq,jq;
3066: int *perm;
3067: union oNDC hc;
3068: P cont,cont1;
3069:
3070: if ( nd_nora ) return f;
3071: n = length(f);
1.24 noro 3072: ndv_setup(m,0,f,0,1,0);
1.1 noro 3073: perm = (int *)MALLOC(n*sizeof(int));
3074: if ( nd_gentrace ) {
3075: for ( t = nd_tracelist, i = 0; i < n; i++, t = NEXT(t) )
1.6 noro 3076: perm[i] = ZTOS((Q)ARG1(BDY((LIST)BDY(t))));
1.1 noro 3077: }
3078: for ( i = 0; i < n; ) {
3079: if ( nd_gentrace ) {
3080: /* Trace = [1,index,1,1] */
1.6 noro 3081: STOZ(i,iq); node = mknode(4,ONE,iq,ONE,ONE);
1.1 noro 3082: MKLIST(l,node); MKNODE(nd_tracelist,l,0);
3083: }
3084: g = ndvtond(m,nd_ps[i]);
3085: g = nd_separate_head(g,&head);
1.6 noro 3086: stat = nd_nf(m,head,g,nd_ps,1,&nf);
1.1 noro 3087: if ( !stat )
3088: nd_reconstruct(0,0);
3089: else {
3090: if ( DP_Print ) { printf("."); fflush(stdout); }
3091: ndv_free(nd_ps[i]);
3092: hc = HCU(nf); nd_removecont(m,nf);
3093: if ( nd_gentrace ) {
3094: for ( t = nd_tracelist; t; t = NEXT(t) ) {
1.6 noro 3095: jq = ARG1(BDY((LIST)BDY(t))); j = ZTOS(jq);
3096: STOZ(perm[j],jq); ARG1(BDY((LIST)BDY(t))) = jq;
1.1 noro 3097: }
1.6 noro 3098: /* exact division */
1.1 noro 3099: cont = ndc_div(m,hc,HCU(nf));
3100: finalize_tracelist(perm[i],cont);
3101: }
3102: nd_ps[i] = ndtondv(m,nf); nd_free(nf);
3103: nd_bound[i] = ndv_compute_bound(nd_ps[i]);
3104: i++;
3105: }
3106: }
3107: if ( DP_Print ) { printf("\n"); }
3108: for ( a0 = 0, i = 0; i < n; i++ ) {
3109: NEXTNODE(a0,a);
3110: if ( !nd_gentrace ) BDY(a) = (pointer)nd_ps[i];
3111: else {
3112: for ( j = 0; j < n; j++ ) if ( perm[j] == i ) break;
3113: BDY(a) = (pointer)nd_ps[j];
3114: }
3115: }
3116: NEXT(a) = 0;
3117: return a0;
3118: }
3119:
3120: ND_pairs update_pairs( ND_pairs d, NODE /* of index */ g, int t, int gensyz)
3121: {
3122: ND_pairs d1,nd,cur,head,prev,remove;
3123:
3124: if ( !g ) return d;
3125: /* for testing */
3126: if ( gensyz && nd_gensyz == 2 ) {
3127: d1 = nd_newpairs(g,t);
3128: if ( !d )
3129: return d1;
3130: else {
3131: nd = d;
3132: while ( NEXT(nd) ) nd = NEXT(nd);
3133: NEXT(nd) = d1;
3134: return d;
3135: }
3136: }
3137: d = crit_B(d,t);
3138: d1 = nd_newpairs(g,t);
3139: d1 = crit_M(d1);
3140: d1 = crit_F(d1);
3141: if ( gensyz || do_weyl )
3142: head = d1;
3143: else {
3144: prev = 0; cur = head = d1;
3145: while ( cur ) {
3146: if ( crit_2( cur->i1,cur->i2 ) ) {
3147: remove = cur;
3148: if ( !prev ) head = cur = NEXT(cur);
3149: else cur = NEXT(prev) = NEXT(cur);
3150: FREENDP(remove);
3151: } else {
3152: prev = cur; cur = NEXT(cur);
3153: }
3154: }
3155: }
3156: if ( !d )
3157: return head;
3158: else {
3159: nd = d;
3160: while ( NEXT(nd) ) nd = NEXT(nd);
3161: NEXT(nd) = head;
3162: return d;
3163: }
3164: }
3165:
1.24 noro 3166: ND_pairs merge_pairs_s(ND_pairs d,ND_pairs d1);
3167:
3168: ND_pairs update_pairs_s( ND_pairs d, NODE /* of index */ g, int t,NODE syz)
3169: {
3170: ND_pairs d1;
3171:
3172: if ( !g ) return d;
3173: d1 = nd_newpairs_s(g,t,syz);
3174: d = merge_pairs_s(d,d1);
3175: return d;
3176: }
1.1 noro 3177:
3178: ND_pairs nd_newpairs( NODE g, int t )
3179: {
3180: NODE h;
3181: UINT *dl;
3182: int ts,s,i,t0,min,max;
3183: ND_pairs r,r0;
3184:
3185: dl = DL(nd_psh[t]);
3186: ts = SG(nd_psh[t]) - TD(dl);
1.17 noro 3187: if ( nd_module && nd_intersect && (MPOS(dl) > nd_intersect) ) return 0;
1.1 noro 3188: for ( r0 = 0, h = g; h; h = NEXT(h) ) {
3189: if ( nd_module && (MPOS(DL(nd_psh[(long)BDY(h)])) != MPOS(dl)) )
3190: continue;
3191: if ( nd_gbblock ) {
3192: t0 = (long)BDY(h);
3193: for ( i = 0; nd_gbblock[i] >= 0; i += 2 ) {
3194: min = nd_gbblock[i]; max = nd_gbblock[i+1];
3195: if ( t0 >= min && t0 <= max && t >= min && t <= max )
3196: break;
3197: }
3198: if ( nd_gbblock[i] >= 0 )
3199: continue;
3200: }
3201: NEXTND_pairs(r0,r);
3202: r->i1 = (long)BDY(h);
3203: r->i2 = t;
3204: ndl_lcm(DL(nd_psh[r->i1]),dl,r->lcm);
3205: s = SG(nd_psh[r->i1])-TD(DL(nd_psh[r->i1]));
3206: SG(r) = MAX(s,ts) + TD(LCM(r));
3207: /* experimental */
3208: if ( nd_sugarweight )
3209: r->sugar2 = ndl_weight2(r->lcm);
3210: }
3211: if ( r0 ) NEXT(r) = 0;
3212: return r0;
3213: }
3214:
1.24 noro 3215:
3216: int comp_sig(SIG s1,SIG s2)
3217: {
3218: #if 0
3219: if ( s1->pos > s2->pos ) return 1;
3220: else if ( s1->pos < s2->pos ) return -1;
3221: else return (*cmpdl)(nd_nvar,s1->dl,s2->dl);
3222: #else
3223: static DL m1,m2;
3224: static int nvar;
3225: int ret;
3226:
3227: if ( nvar < nd_nvar ) {
3228: nvar = nd_nvar;
3229: NEWDL(m1,nvar);
3230: NEWDL(m2,nvar);
3231: }
3232: _ndltodl(DL(nd_psh[s1->pos]),m1);
3233: _ndltodl(DL(nd_psh[s2->pos]),m2);
3234: _addtodl(nd_nvar,s1->dl,m1);
3235: _addtodl(nd_nvar,s2->dl,m2);
3236: ret = (*cmpdl)(nd_nvar,m1,m2);
3237: if ( ret != 0 ) return ret;
3238: else if ( s1->pos > s2->pos ) return 1;
3239: else if ( s1->pos < s2->pos ) return -1;
3240: else return 0;
3241: #endif
3242: }
3243:
3244: int _create_spair_s(int i1,int i2,ND_pairs sp,SIG sig1,SIG sig2)
3245: {
3246: int ret,s1,s2;
3247: RHist p1,p2;
3248: static int wpd;
3249: static UINT *lcm;
3250:
3251: sp->i1 = i1;
3252: sp->i2 = i2;
3253: p1 = nd_psh[i1];
3254: p2 = nd_psh[i2];
3255: ndl_lcm(DL(p1),DL(p2),sp->lcm);
3256: s1 = SG(p1)-TD(DL(p1));
3257: s2 = SG(p2)-TD(DL(p2));
3258: SG(sp) = MAX(s1,s2) + TD(sp->lcm);
3259:
3260: if ( wpd < nd_wpd ) {
3261: wpd = nd_wpd;
3262: lcm = (UINT *)MALLOC(wpd*sizeof(UINT));
3263: }
3264: // DL(sig1) <- sp->lcm
3265: // DL(sig1) -= DL(p1)
3266: // DL(sig1) += DL(p1->sig)
3267: ndl_copy(sp->lcm,lcm);
3268: ndl_subfrom(lcm,DL(p1));
3269: _ndltodl(lcm,DL(sig1));
3270: _addtodl(nd_nvar,DL(p1->sig),DL(sig1));
3271: sig1->pos = p1->sig->pos;
3272:
3273: // DL(sig2) <- sp->lcm
3274: // DL(sig2) -= DL(p2)
3275: // DL(sig2) += DL(p2->sig)
3276: ndl_copy(sp->lcm,lcm);
3277: ndl_subfrom(lcm,DL(p2));
3278: _ndltodl(lcm,DL(sig2));
3279: _addtodl(nd_nvar,DL(p2->sig),DL(sig2));
3280: sig2->pos = p2->sig->pos;
3281:
3282: ret = comp_sig(sig1,sig2);
3283: if ( ret == 0 ) return 0;
3284: else if ( ret > 0 ) sp->sig = sig1;
3285: else sp->sig = sig2;
3286: return 1;
3287: }
3288:
3289: SIG dup_sig(SIG sig)
3290: {
3291: SIG r;
3292:
3293: if ( !sig ) return 0;
3294: else {
3295: NEWSIG(r);
3296: _copydl(nd_nvar,DL(sig),DL(r));
3297: r->pos = sig->pos;
3298: return r;
3299: }
3300: }
3301:
3302: void dup_ND_pairs(ND_pairs to,ND_pairs from)
3303: {
3304: to->i1 = from->i1;
3305: to->i2 = from->i2;
3306: to->sugar = from->sugar;
3307: to->sugar2 = from->sugar2;
3308: ndl_copy(from->lcm,to->lcm);
3309: to->sig = dup_sig(from->sig);
3310: }
3311:
3312: ND_pairs merge_pairs_s(ND_pairs p1,ND_pairs p2)
3313: {
3314: struct oND_pairs root;
3315: ND_pairs q1,q2,r0,r;
3316: int ret;
3317:
3318: r = &root;
3319: for ( q1 = p1, q2 = p2; q1 != 0 && q2 != 0; ) {
3320: ret = comp_sig(q1->sig,q2->sig);
3321: if ( ret < 0 ) {
3322: r->next = q1; r = q1; q1 = q1->next;
3323: } else if ( ret > 0 ) {
3324: r->next = q2; r = q2; q2 = q2->next;
3325: } else {
3326: ret = DL_COMPARE(q1->lcm,q2->lcm);
3327: if ( ret < 0 ) {
3328: r->next = q1; r = q1; q1 = q1->next;
3329: q2 = q2->next;
3330: } else {
3331: r->next = q2; r = q2; q2 = q2->next;
3332: q1 = q1->next;
3333: }
3334: }
3335: }
3336: if ( q1 ) {
3337: r->next = q1;
3338: } else {
3339: r->next = q2;
3340: }
3341: return root.next;
3342: }
3343:
3344: ND_pairs insert_pair_s(ND_pairs l,ND_pairs s)
3345: {
3346: ND_pairs p,prev;
3347: int ret;
3348:
3349: for ( p = l, prev = 0; p != 0; prev = p, p = p->next ) {
3350: if ( (ret = comp_sig(s->sig,p->sig)) <= 0 )
3351: break;
3352: }
3353: if ( ret == 0 ) {
3354: ret = DL_COMPARE(s->lcm,p->lcm);
3355: if ( ret < 0 ) {
3356: // replace p with s
3357: s->next = p->next;
3358: if ( prev == 0 ) {
3359: return s;
3360: } else {
3361: prev->next = s;
3362: return l;
3363: }
3364: } else
3365: return l;
3366: } else {
3367: // insert s between prev and p
3368: s->next = p;
3369: if ( prev == 0 ) {
3370: return s;
3371: } else {
3372: prev->next = s;
3373: return l;
3374: }
3375: }
3376: }
3377:
3378: ND_pairs nd_newpairs_s( NODE g, int t, NODE syz)
3379: {
3380: NODE h,s;
3381: UINT *dl;
3382: int ts,ret;
3383: ND_pairs r,r0,_sp,sp;
3384: SIG _sig1,_sig2,spsig,tsig;
3385:
3386: dl = DL(nd_psh[t]);
3387: ts = SG(nd_psh[t]) - TD(dl);
3388: NEWND_pairs(_sp);
3389: NEWSIG(_sig1); NEWSIG(_sig2);
3390: r0 = 0;
3391: for ( h = g; h; h = NEXT(h) ) {
3392: ret = _create_spair_s((long)BDY(h),t,_sp,_sig1,_sig2);
3393: if ( ret ) {
3394: spsig = _sp->sig;
3395: for ( s = syz; s; s = s->next ) {
3396: tsig = (SIG)s->body;
3397: if ( tsig->pos == spsig->pos && _dl_redble(DL(tsig),DL(spsig),nd_nvar) )
3398: break;
3399: }
3400: if ( s == 0 ) {
3401: NEWND_pairs(sp);
3402: dup_ND_pairs(sp,_sp);
3403: r0 = insert_pair_s(r0,sp);
3404: }
3405: }
3406: }
3407: return r0;
3408: }
3409:
1.1 noro 3410: /* ipair = [i1,i2],[i1,i2],... */
3411: ND_pairs nd_ipairtospair(NODE ipair)
3412: {
3413: int s1,s2;
3414: NODE tn,t;
3415: ND_pairs r,r0;
3416:
3417: for ( r0 = 0, t = ipair; t; t = NEXT(t) ) {
3418: NEXTND_pairs(r0,r);
3419: tn = BDY((LIST)BDY(t));
1.6 noro 3420: r->i1 = ZTOS((Q)ARG0(tn));
3421: r->i2 = ZTOS((Q)ARG1(tn));
1.1 noro 3422: ndl_lcm(DL(nd_psh[r->i1]),DL(nd_psh[r->i2]),r->lcm);
3423: s1 = SG(nd_psh[r->i1])-TD(DL(nd_psh[r->i1]));
3424: s2 = SG(nd_psh[r->i2])-TD(DL(nd_psh[r->i2]));
3425: SG(r) = MAX(s1,s2) + TD(LCM(r));
3426: /* experimental */
3427: if ( nd_sugarweight )
3428: r->sugar2 = ndl_weight2(r->lcm);
3429: }
3430: if ( r0 ) NEXT(r) = 0;
3431: return r0;
3432: }
3433:
3434: /* kokokara */
3435:
3436: ND_pairs crit_B( ND_pairs d, int s )
3437: {
3438: ND_pairs cur,head,prev,remove;
3439: UINT *t,*tl,*lcm;
3440: int td,tdl;
3441:
3442: if ( !d ) return 0;
3443: t = DL(nd_psh[s]);
3444: prev = 0;
3445: head = cur = d;
3446: lcm = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
3447: while ( cur ) {
3448: tl = cur->lcm;
3449: if ( ndl_reducible(tl,t) ) {
3450: ndl_lcm(DL(nd_psh[cur->i1]),t,lcm);
3451: if ( !ndl_equal(lcm,tl) ) {
3452: ndl_lcm(DL(nd_psh[cur->i2]),t,lcm);
3453: if (!ndl_equal(lcm,tl)) {
3454: remove = cur;
3455: if ( !prev ) {
3456: head = cur = NEXT(cur);
3457: } else {
3458: cur = NEXT(prev) = NEXT(cur);
3459: }
3460: FREENDP(remove);
3461: } else {
3462: prev = cur; cur = NEXT(cur);
3463: }
3464: } else {
3465: prev = cur; cur = NEXT(cur);
3466: }
3467: } else {
3468: prev = cur; cur = NEXT(cur);
3469: }
3470: }
3471: return head;
3472: }
3473:
3474: ND_pairs crit_M( ND_pairs d1 )
3475: {
3476: ND_pairs e,d2,d3,dd,p;
3477: UINT *id,*jd;
3478:
3479: if ( !d1 ) return d1;
3480: for ( dd = 0, e = d1; e; e = d3 ) {
3481: if ( !(d2 = NEXT(e)) ) {
3482: NEXT(e) = dd;
3483: return e;
3484: }
3485: id = LCM(e);
3486: for ( d3 = 0; d2; d2 = p ) {
3487: p = NEXT(d2);
3488: jd = LCM(d2);
3489: if ( ndl_equal(jd,id) )
3490: ;
3491: else if ( TD(jd) > TD(id) )
3492: if ( ndl_reducible(jd,id) ) continue;
3493: else ;
3494: else if ( ndl_reducible(id,jd) ) goto delit;
3495: NEXT(d2) = d3;
3496: d3 = d2;
3497: }
3498: NEXT(e) = dd;
3499: dd = e;
3500: continue;
3501: /**/
3502: delit: NEXT(d2) = d3;
3503: d3 = d2;
3504: for ( ; p; p = d2 ) {
3505: d2 = NEXT(p);
3506: NEXT(p) = d3;
3507: d3 = p;
3508: }
3509: FREENDP(e);
3510: }
3511: return dd;
3512: }
3513:
3514: ND_pairs crit_F( ND_pairs d1 )
3515: {
3516: ND_pairs rest, head,remove;
3517: ND_pairs last, p, r, w;
3518: int s;
3519:
3520: if ( !d1 ) return d1;
3521: for ( head = last = 0, p = d1; NEXT(p); ) {
3522: r = w = equivalent_pairs(p,&rest);
3523: s = SG(r);
3524: w = NEXT(w);
3525: while ( w ) {
3526: if ( crit_2(w->i1,w->i2) ) {
3527: r = w;
3528: w = NEXT(w);
3529: while ( w ) {
3530: remove = w;
3531: w = NEXT(w);
3532: FREENDP(remove);
3533: }
3534: break;
3535: } else if ( SG(w) < s ) {
3536: FREENDP(r);
3537: r = w;
3538: s = SG(r);
3539: w = NEXT(w);
3540: } else {
3541: remove = w;
3542: w = NEXT(w);
3543: FREENDP(remove);
3544: }
3545: }
3546: if ( last ) NEXT(last) = r;
3547: else head = r;
3548: NEXT(last = r) = 0;
3549: p = rest;
3550: if ( !p ) return head;
3551: }
3552: if ( !last ) return p;
3553: NEXT(last) = p;
3554: return head;
3555: }
3556:
3557: int crit_2( int dp1, int dp2 )
3558: {
3559: return ndl_disjoint(DL(nd_psh[dp1]),DL(nd_psh[dp2]));
3560: }
3561:
3562: ND_pairs equivalent_pairs( ND_pairs d1, ND_pairs *prest )
3563: {
3564: ND_pairs w,p,r,s;
3565: UINT *d;
3566:
3567: w = d1;
3568: d = LCM(w);
3569: s = NEXT(w);
3570: NEXT(w) = 0;
3571: for ( r = 0; s; s = p ) {
3572: p = NEXT(s);
3573: if ( ndl_equal(d,LCM(s)) ) {
3574: NEXT(s) = w; w = s;
3575: } else {
3576: NEXT(s) = r; r = s;
3577: }
3578: }
3579: *prest = r;
3580: return w;
3581: }
3582:
3583: NODE update_base(NODE nd,int ndp)
3584: {
3585: UINT *dl, *dln;
3586: NODE last, p, head;
3587:
3588: dl = DL(nd_psh[ndp]);
3589: for ( head = last = 0, p = nd; p; ) {
3590: dln = DL(nd_psh[(long)BDY(p)]);
3591: if ( ndl_reducible( dln, dl ) ) {
3592: p = NEXT(p);
3593: if ( last ) NEXT(last) = p;
3594: } else {
3595: if ( !last ) head = p;
3596: p = NEXT(last = p);
3597: }
3598: }
3599: head = append_one(head,ndp);
3600: return head;
3601: }
3602:
3603: ND_pairs nd_minp( ND_pairs d, ND_pairs *prest )
3604: {
3605: ND_pairs m,ml,p,l;
3606: UINT *lcm;
3607: int s,td,len,tlen,c,c1;
3608:
3609: if ( !(p = NEXT(m = d)) ) {
3610: *prest = p;
3611: NEXT(m) = 0;
3612: return m;
3613: }
3614: if ( !NoSugar ) {
3615: if ( nd_sugarweight ) {
3616: s = m->sugar2;
3617: for ( ml = 0, l = m; p; p = NEXT(l = p) )
3618: if ( (p->sugar2 < s)
3619: || ((p->sugar2 == s) && (DL_COMPARE(LCM(p),LCM(m)) < 0)) ) {
3620: ml = l; m = p; s = m->sugar2;
3621: }
3622: } else {
3623: s = SG(m);
3624: for ( ml = 0, l = m; p; p = NEXT(l = p) )
3625: if ( (SG(p) < s)
3626: || ((SG(p) == s) && (DL_COMPARE(LCM(p),LCM(m)) < 0)) ) {
3627: ml = l; m = p; s = SG(m);
3628: }
3629: }
3630: } else {
3631: for ( ml = 0, l = m; p; p = NEXT(l = p) )
3632: if ( DL_COMPARE(LCM(p),LCM(m)) < 0 ) {
3633: ml = l; m = p; s = SG(m);
3634: }
3635: }
3636: if ( !ml ) *prest = NEXT(m);
3637: else {
3638: NEXT(ml) = NEXT(m);
3639: *prest = d;
3640: }
3641: NEXT(m) = 0;
3642: return m;
3643: }
3644:
3645: ND_pairs nd_minsugarp( ND_pairs d, ND_pairs *prest )
3646: {
3647: int msugar,i;
3648: ND_pairs t,dm0,dm,dr0,dr;
3649:
3650: if ( nd_sugarweight ) {
3651: for ( msugar = d->sugar2, t = NEXT(d); t; t = NEXT(t) )
3652: if ( t->sugar2 < msugar ) msugar = t->sugar2;
3653: dm0 = 0; dr0 = 0;
3654: for ( i = 0, t = d; t; t = NEXT(t) )
3655: if ( i < nd_f4_nsp && t->sugar2 == msugar ) {
3656: if ( dm0 ) NEXT(dm) = t;
3657: else dm0 = t;
3658: dm = t;
3659: i++;
3660: } else {
3661: if ( dr0 ) NEXT(dr) = t;
3662: else dr0 = t;
3663: dr = t;
3664: }
3665: } else {
3666: for ( msugar = SG(d), t = NEXT(d); t; t = NEXT(t) )
3667: if ( SG(t) < msugar ) msugar = SG(t);
3668: dm0 = 0; dr0 = 0;
3669: for ( i = 0, t = d; t; t = NEXT(t) )
3670: if ( i < nd_f4_nsp && SG(t) == msugar ) {
3671: if ( dm0 ) NEXT(dm) = t;
3672: else dm0 = t;
3673: dm = t;
3674: i++;
3675: } else {
3676: if ( dr0 ) NEXT(dr) = t;
3677: else dr0 = t;
3678: dr = t;
3679: }
3680: }
3681: NEXT(dm) = 0;
3682: if ( dr0 ) NEXT(dr) = 0;
3683: *prest = dr0;
3684: return dm0;
3685: }
3686:
3687: int nd_tdeg(NDV c)
3688: {
3689: int wmax = 0;
3690: int i,len;
3691: NMV a;
3692:
3693: len = LEN(c);
3694: for ( a = BDY(c), i = 0; i < len; i++, NMV_ADV(a) )
3695: wmax = MAX(TD(DL(a)),wmax);
3696: return wmax;
3697: }
3698:
1.24 noro 3699: int ndv_newps(int m,NDV a,NDV aq)
1.1 noro 3700: {
3701: int len;
3702: RHist r;
3703: NDV b;
3704: NODE tn;
3705: LIST l;
3706: Z iq;
3707:
3708: if ( nd_psn == nd_pslen ) {
3709: nd_pslen *= 2;
3710: nd_ps = (NDV *)REALLOC((char *)nd_ps,nd_pslen*sizeof(NDV));
3711: nd_ps_trace = (NDV *)REALLOC((char *)nd_ps_trace,nd_pslen*sizeof(NDV));
3712: nd_psh = (RHist *)REALLOC((char *)nd_psh,nd_pslen*sizeof(RHist));
3713: nd_bound = (UINT **)
3714: REALLOC((char *)nd_bound,nd_pslen*sizeof(UINT *));
3715: nd_ps_sym = (NDV *)REALLOC((char *)nd_ps_sym,nd_pslen*sizeof(NDV));
3716: nd_ps_trace_sym = (NDV *)REALLOC((char *)nd_ps_trace_sym,nd_pslen*sizeof(NDV));
3717: }
3718: NEWRHist(r); nd_psh[nd_psn] = r;
3719: nd_ps[nd_psn] = a;
3720: if ( aq ) {
3721: nd_ps_trace[nd_psn] = aq;
3722: if ( !m ) {
3723: register_hcf(aq);
3724: } else if ( m == -2 ) {
3725: /* do nothing */
3726: } else
3727: error("ndv_newps : invalud modulus");
3728: nd_bound[nd_psn] = ndv_compute_bound(aq);
3729: #if 1
3730: SG(r) = SG(aq);
3731: #else
3732: SG(r) = nd_tdeg(aq);
3733: #endif
3734: ndl_copy(HDL(aq),DL(r));
1.24 noro 3735: r->sig = dup_sig(aq->sig);
1.1 noro 3736: } else {
3737: if ( !m ) register_hcf(a);
3738: nd_bound[nd_psn] = ndv_compute_bound(a);
3739: #if 1
3740: SG(r) = SG(a);
3741: #else
3742: SG(r) = nd_tdeg(a);
3743: #endif
3744: ndl_copy(HDL(a),DL(r));
1.24 noro 3745: r->sig = dup_sig(a->sig);
1.1 noro 3746: }
3747: if ( nd_demand ) {
3748: if ( aq ) {
3749: ndv_save(nd_ps_trace[nd_psn],nd_psn);
3750: nd_ps_sym[nd_psn] = ndv_symbolic(m,nd_ps_trace[nd_psn]);
3751: nd_ps_trace_sym[nd_psn] = ndv_symbolic(m,nd_ps_trace[nd_psn]);
3752: nd_ps_trace[nd_psn] = 0;
3753: } else {
3754: ndv_save(nd_ps[nd_psn],nd_psn);
3755: nd_ps_sym[nd_psn] = ndv_symbolic(m,nd_ps[nd_psn]);
3756: nd_ps[nd_psn] = 0;
3757: }
3758: }
3759: if ( nd_gentrace ) {
3760: /* reverse the tracelist and append it to alltracelist */
3761: nd_tracelist = reverse_node(nd_tracelist); MKLIST(l,nd_tracelist);
1.6 noro 3762: STOZ(nd_psn,iq); tn = mknode(2,iq,l); MKLIST(l,tn);
1.1 noro 3763: MKNODE(tn,l,nd_alltracelist); nd_alltracelist = tn; nd_tracelist = 0;
3764: }
3765: return nd_psn++;
3766: }
3767:
3768: /* nd_tracelist = [[0,index,div],...,[nd_psn-1,index,div]] */
3769: /* return 1 if success, 0 if failure (HC(a mod p)) */
3770:
1.24 noro 3771: int ndv_setup(int mod,int trace,NODE f,int dont_sort,int dont_removecont,int sba)
1.1 noro 3772: {
1.6 noro 3773: int i,j,td,len,max;
3774: NODE s,s0,f0,tn;
3775: UINT *d;
3776: RHist r;
3777: NDVI w;
3778: NDV a,am;
3779: union oNDC hc;
3780: NODE node;
3781: P hcp;
3782: Z iq,jq;
3783: LIST l;
3784:
3785: nd_found = 0; nd_notfirst = 0; nd_create = 0;
3786: /* initialize the tracelist */
3787: nd_tracelist = 0;
3788:
3789: for ( nd_psn = 0, s = f; s; s = NEXT(s) ) if ( BDY(s) ) nd_psn++;
3790: w = (NDVI)MALLOC(nd_psn*sizeof(struct oNDVI));
3791: for ( i = j = 0, s = f; s; s = NEXT(s), j++ )
3792: if ( BDY(s) ) { w[i].p = BDY(s); w[i].i = j; i++; }
3793: if ( !dont_sort ) {
3794: /* XXX heuristic */
3795: if ( !nd_ord->id && (nd_ord->ord.simple<2) )
3796: qsort(w,nd_psn,sizeof(struct oNDVI),
3797: (int (*)(const void *,const void *))ndvi_compare_rev);
3798: else
3799: qsort(w,nd_psn,sizeof(struct oNDVI),
3800: (int (*)(const void *,const void *))ndvi_compare);
3801: }
3802: nd_pslen = 2*nd_psn;
3803: nd_ps = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3804: nd_ps_trace = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3805: nd_ps_sym = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3806: nd_ps_trace_sym = (NDV *)MALLOC(nd_pslen*sizeof(NDV));
3807: nd_psh = (RHist *)MALLOC(nd_pslen*sizeof(RHist));
3808: nd_bound = (UINT **)MALLOC(nd_pslen*sizeof(UINT *));
3809: nd_hcf = 0;
1.1 noro 3810:
1.6 noro 3811: if ( trace && nd_vc )
3812: makesubst(nd_vc,&nd_subst);
3813: else
3814: nd_subst = 0;
1.1 noro 3815:
1.6 noro 3816: if ( !nd_red )
3817: nd_red = (RHist *)MALLOC(REDTAB_LEN*sizeof(RHist));
3818: for ( i = 0; i < REDTAB_LEN; i++ ) nd_red[i] = 0;
3819: for ( i = 0; i < nd_psn; i++ ) {
3820: hc = HCU(w[i].p);
3821: if ( trace ) {
3822: if ( mod == -2 ) {
3823: /* over a large finite field */
3824: /* trace = small modulus */
3825: a = nd_ps_trace[i] = ndv_dup(-2,w[i].p);
3826: ndv_mod(-2,a);
3827: if ( !dont_removecont) ndv_removecont(-2,a);
3828: am = nd_ps[i] = ndv_dup(trace,w[i].p);
3829: ndv_mod(trace,am);
3830: if ( DL_COMPARE(HDL(am),HDL(a)) )
3831: return 0;
3832: ndv_removecont(trace,am);
3833: } else {
3834: a = nd_ps_trace[i] = ndv_dup(0,w[i].p);
3835: if ( !dont_removecont) ndv_removecont(0,a);
3836: register_hcf(a);
3837: am = nd_ps[i] = ndv_dup(mod,a);
3838: ndv_mod(mod,am);
3839: if ( DL_COMPARE(HDL(am),HDL(a)) )
3840: return 0;
3841: ndv_removecont(mod,am);
3842: }
3843: } else {
3844: a = nd_ps[i] = ndv_dup(mod,w[i].p);
3845: if ( mod || !dont_removecont ) ndv_removecont(mod,a);
3846: if ( !mod ) register_hcf(a);
1.1 noro 3847: }
1.6 noro 3848: if ( nd_gentrace ) {
3849: STOZ(i,iq); STOZ(w[i].i,jq); node = mknode(3,iq,jq,ONE);
3850: /* exact division */
1.1 noro 3851: if ( !dont_removecont )
1.6 noro 3852: ARG2(node) = (pointer)ndc_div(trace?0:mod,hc,HCU(a));
3853: MKLIST(l,node); NEXTNODE(nd_tracelist,tn); BDY(tn) = l;
3854: }
3855: NEWRHist(r); SG(r) = HTD(a); ndl_copy(HDL(a),DL(r));
3856: nd_bound[i] = ndv_compute_bound(a);
3857: nd_psh[i] = r;
3858: if ( nd_demand ) {
3859: if ( trace ) {
3860: ndv_save(nd_ps_trace[i],i);
3861: nd_ps_sym[i] = ndv_symbolic(mod,nd_ps_trace[i]);
3862: nd_ps_trace_sym[i] = ndv_symbolic(mod,nd_ps_trace[i]);
3863: nd_ps_trace[i] = 0;
3864: } else {
3865: ndv_save(nd_ps[i],i);
3866: nd_ps_sym[i] = ndv_symbolic(mod,nd_ps[i]);
3867: nd_ps[i] = 0;
3868: }
1.1 noro 3869: }
1.6 noro 3870: }
1.24 noro 3871: if ( sba ) {
3872: // setup signatures
3873: for ( i = 0; i < nd_psn; i++ ) {
3874: SIG sig;
3875:
3876: NEWSIG(sig); sig->pos = i;
3877: nd_ps[i]->sig = sig;
3878: if ( nd_demand ) nd_ps_sym[i]->sig = sig;
3879: nd_psh[i]->sig = sig;
3880: if ( trace ) {
3881: nd_ps_trace[i]->sig = sig;
3882: if ( nd_demand ) nd_ps_trace_sym[i]->sig = sig;
3883: }
3884: }
3885: }
1.6 noro 3886: if ( nd_gentrace && nd_tracelist ) NEXT(tn) = 0;
3887: return 1;
1.1 noro 3888: }
3889:
3890: struct order_spec *append_block(struct order_spec *spec,
3891: int nv,int nalg,int ord);
3892:
3893: extern VECT current_dl_weight_vector_obj;
3894: static VECT prev_weight_vector_obj;
3895:
3896: void preprocess_algcoef(VL vv,VL av,struct order_spec *ord,LIST f,
3897: struct order_spec **ord1p,LIST *f1p,NODE *alistp)
3898: {
3899: NODE alist,t,s,r0,r,arg;
3900: VL tv;
3901: P poly;
3902: DP d;
3903: Alg alpha,dp;
3904: DAlg inv,da,hc;
3905: MP m;
3906: int i,nvar,nalg,n;
3907: NumberField nf;
3908: LIST f1,f2;
3909: struct order_spec *current_spec;
3910: VECT obj,obj0;
3911: VECT tmp;
3912:
3913: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++);
3914: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++);
3915:
3916: for ( alist = 0, tv = av; tv; tv = NEXT(tv) ) {
3917: NEXTNODE(alist,t); MKV(tv->v,poly);
3918: MKAlg(poly,alpha); BDY(t) = (pointer)alpha;
3919: tv->v = tv->v->priv;
3920: }
3921: NEXT(t) = 0;
3922:
3923: /* simplification, making polynomials monic */
3924: setfield_dalg(alist);
3925: obj_algtodalg((Obj)f,(Obj *)&f1);
3926: for ( t = BDY(f); t; t = NEXT(t) ) {
3927: initd(ord); ptod(vv,vv,(P)BDY(t),&d);
3928: hc = (DAlg)BDY(d)->c;
3929: if ( NID(hc) == N_DA ) {
3930: invdalg(hc,&inv);
3931: for ( m = BDY(d); m; m = NEXT(m) ) {
3932: muldalg(inv,(DAlg)m->c,&da); m->c = (Obj)da;
3933: }
3934: }
3935: initd(ord); dtop(vv,vv,d,(Obj *)&poly); BDY(f) = (pointer)poly;
3936: }
3937: obj_dalgtoalg((Obj)f1,(Obj *)&f);
3938:
3939: /* append alg vars to the var list */
3940: for ( tv = vv; NEXT(tv); tv = NEXT(tv) );
3941: NEXT(tv) = av;
3942:
3943: /* append a block to ord */
3944: *ord1p = append_block(ord,nvar,nalg,2);
3945:
3946: /* create generator list */
3947: nf = get_numberfield();
3948: for ( i = nalg-1, t = BDY(f); i >= 0; i-- ) {
3949: MKAlg(nf->defpoly[i],dp);
3950: MKNODE(s,dp,t); t = s;
3951: }
3952: MKLIST(f1,t);
3953: *alistp = alist;
3954: algobjtorat((Obj)f1,(Obj *)f1p);
3955:
3956: /* creating a new weight vector */
3957: prev_weight_vector_obj = obj0 = current_dl_weight_vector_obj;
3958: n = nvar+nalg+1;
3959: MKVECT(obj,n);
3960: if ( obj0 && obj0->len == nvar )
3961: for ( i = 0; i < nvar; i++ ) BDY(obj)[i] = BDY(obj0)[i];
3962: else
3963: for ( i = 0; i < nvar; i++ ) BDY(obj)[i] = (pointer)ONE;
3964: for ( i = 0; i < nalg; i++ ) BDY(obj)[i+nvar] = 0;
3965: BDY(obj)[n-1] = (pointer)ONE;
3966: arg = mknode(1,obj);
3967: Pdp_set_weight(arg,&tmp);
3968: }
3969:
3970: NODE postprocess_algcoef(VL av,NODE alist,NODE r)
3971: {
3972: NODE s,t,u0,u;
3973: P p;
3974: VL tv;
3975: Obj obj;
3976: VECT tmp;
3977: NODE arg;
3978:
3979: u0 = 0;
3980: for ( t = r; t; t = NEXT(t) ) {
3981: p = (P)BDY(t);
3982: for ( tv = av, s = alist; tv; tv = NEXT(tv), s = NEXT(s) ) {
3983: substr(CO,0,(Obj)p,tv->v,(Obj)BDY(s),&obj); p = (P)obj;
3984: }
3985: if ( OID(p) == O_P || (OID(p) == O_N && NID((Num)p) != N_A) ) {
3986: NEXTNODE(u0,u);
3987: BDY(u) = (pointer)p;
3988: }
3989: }
3990: arg = mknode(1,prev_weight_vector_obj);
3991: Pdp_set_weight(arg,&tmp);
3992:
3993: return u0;
3994: }
3995:
3996: void nd_gr(LIST f,LIST v,int m,int homo,int retdp,int f4,struct order_spec *ord,LIST *rp)
3997: {
3998: VL tv,fv,vv,vc,av;
3999: NODE fd,fd0,r,r0,t,x,s,xx,alist;
4000: int e,max,nvar,i;
4001: NDV b;
4002: int ishomo,nalg,mrank,trank,wmax,len;
4003: NMV a;
4004: Alg alpha,dp;
4005: P p,zp;
4006: Q dmy;
4007: LIST f1,f2,zpl;
4008: Obj obj;
4009: NumberField nf;
4010: struct order_spec *ord1;
4011: NODE tr,tl1,tl2,tl3,tl4,nzlist;
4012: LIST l1,l2,l3,l4,l5;
4013: int j;
4014: Z jq,bpe,last_nonzero;
4015: int *perm;
4016: EPOS oepos;
4017: int obpe,oadv,ompos,cbpe;
1.15 noro 4018: VECT hvect;
1.1 noro 4019:
4020: nd_module = 0;
4021: if ( !m && Demand ) nd_demand = 1;
4022: else nd_demand = 0;
4023: parse_nd_option(current_option);
4024:
4025: if ( DP_Multiple )
4026: nd_scale = ((double)DP_Multiple)/(double)(Denominator?Denominator:1);
4027: #if 0
4028: ndv_alloc = 0;
4029: #endif
4030: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
4031: if ( m && nd_vc )
4032: error("nd_{gr,f4} : computation over Fp(X) is unsupported. Use dp_gr_mod_main().");
4033: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
4034: switch ( ord->id ) {
4035: case 1:
4036: if ( ord->nv != nvar )
4037: error("nd_{gr,f4} : invalid order specification");
4038: break;
4039: default:
4040: break;
4041: }
4042: nd_nalg = 0;
4043: av = 0;
4044: if ( !m ) {
4045: get_algtree((Obj)f,&av);
4046: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++ );
4047: nd_ntrans = nvar;
4048: nd_nalg = nalg;
4049: /* #i -> t#i */
4050: if ( nalg ) {
4051: preprocess_algcoef(vv,av,ord,f,&ord1,&f1,&alist);
4052: ord = ord1;
4053: f = f1;
4054: }
4055: nvar += nalg;
4056: }
4057: nd_init_ord(ord);
4058: mrank = 0;
4059: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
4060: for ( tv = vv; tv; tv = NEXT(tv) ) {
4061: if ( nd_module ) {
1.16 noro 4062: if ( OID(BDY(t)) == O_DPM ) {
4063: e = dpm_getdeg((DPM)BDY(t),&trank);
4064: max = MAX(e,max);
4065: mrank = MAX(mrank,trank);
4066: } else {
4067: s = BDY((LIST)BDY(t));
4068: trank = length(s);
4069: mrank = MAX(mrank,trank);
4070: for ( ; s; s = NEXT(s) ) {
4071: e = getdeg(tv->v,(P)BDY(s));
4072: max = MAX(e,max);
4073: }
1.1 noro 4074: }
4075: } else {
4076: e = getdeg(tv->v,(P)BDY(t));
4077: max = MAX(e,max);
4078: }
4079: }
4080: nd_setup_parameters(nvar,nd_nzlist?0:max);
4081: obpe = nd_bpe; oadv = nmv_adv; oepos = nd_epos; ompos = nd_mpos;
4082: ishomo = 1;
4083: for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
4084: if ( nd_module ) {
1.16 noro 4085: if ( OID(BDY(t)) == O_DPM ) {
4086: Z cont;
4087: DPM zdpm;
4088:
4089: if ( !m && !nd_gentrace ) dpm_ptozp((DPM)BDY(t),&cont,&zdpm);
4090: else zdpm = (DPM)BDY(t);
4091: b = (pointer)dpmtondv(m,zdpm);
4092: } else {
4093: if ( !m && !nd_gentrace ) pltozpl((LIST)BDY(t),&dmy,&zpl);
4094: else zpl = (LIST)BDY(t);
1.1 noro 4095: b = (pointer)pltondv(CO,vv,zpl);
1.16 noro 4096: }
1.1 noro 4097: } else {
4098: if ( !m && !nd_gentrace ) ptozp((P)BDY(t),1,&dmy,&zp);
4099: else zp = (P)BDY(t);
4100: b = (pointer)ptondv(CO,vv,zp);
4101: }
4102: if ( ishomo )
4103: ishomo = ishomo && ndv_ishomo(b);
4104: if ( m ) ndv_mod(m,b);
4105: if ( b ) { NEXTNODE(fd0,fd); BDY(fd) = (pointer)b; }
4106: }
4107: if ( fd0 ) NEXT(fd) = 0;
4108:
4109: if ( !ishomo && homo ) {
4110: for ( t = fd0, wmax = max; t; t = NEXT(t) ) {
4111: b = (NDV)BDY(t); len = LEN(b);
4112: for ( a = BDY(b), i = 0; i < len; i++, NMV_ADV(a) )
4113: wmax = MAX(TD(DL(a)),wmax);
4114: }
4115: homogenize_order(ord,nvar,&ord1);
4116: nd_init_ord(ord1);
4117: nd_setup_parameters(nvar+1,nd_nzlist?0:wmax);
4118: for ( t = fd0; t; t = NEXT(t) )
4119: ndv_homogenize((NDV)BDY(t),obpe,oadv,oepos,ompos);
4120: }
4121:
1.24 noro 4122: ndv_setup(m,0,fd0,(nd_gbblock||nd_splist||nd_check_splist)?1:0,0,0);
1.1 noro 4123: if ( nd_gentrace ) {
4124: MKLIST(l1,nd_tracelist); MKNODE(nd_alltracelist,l1,0);
4125: }
4126: if ( nd_splist ) {
4127: *rp = compute_splist();
4128: return;
4129: }
4130: if ( nd_check_splist ) {
4131: if ( f4 ) {
4132: if ( check_splist_f4(m,nd_check_splist) ) *rp = (LIST)ONE;
4133: else *rp = 0;
4134: } else {
4135: if ( check_splist(m,nd_check_splist) ) *rp = (LIST)ONE;
4136: else *rp = 0;
4137: }
4138: return;
4139: }
4140: x = f4?nd_f4(m,0,&perm):nd_gb(m,ishomo || homo,0,0,&perm);
4141: if ( !x ) {
4142: *rp = 0; return;
4143: }
1.15 noro 4144: if ( nd_gentrace ) {
4145: MKVECT(hvect,nd_psn);
4146: for ( i = 0; i < nd_psn; i++ )
4147: ndltodp(nd_psh[i]->dl,(DP *)&BDY(hvect)[i]);
4148: }
1.1 noro 4149: if ( !ishomo && homo ) {
4150: /* dehomogenization */
4151: for ( t = x; t; t = NEXT(t) ) ndv_dehomogenize((NDV)BDY(t),ord);
4152: nd_init_ord(ord);
4153: nd_setup_parameters(nvar,0);
4154: }
4155: nd_demand = 0;
4156: if ( nd_module && nd_intersect ) {
4157: for ( j = nd_psn-1, x = 0; j >= 0; j-- )
1.17 noro 4158: if ( MPOS(DL(nd_psh[j])) > nd_intersect ) {
1.1 noro 4159: MKNODE(xx,(pointer)((unsigned long)j),x); x = xx;
4160: }
4161: conv_ilist(nd_demand,0,x,0);
4162: goto FINAL;
4163: }
4164: if ( nd_gentrace && f4 ) { nzlist = nd_alltracelist; }
4165: x = ndv_reducebase(x,perm);
4166: if ( nd_gentrace && !f4 ) { tl1 = nd_alltracelist; nd_alltracelist = 0; }
4167: x = ndv_reduceall(m,x);
4168: cbpe = nd_bpe;
4169: if ( nd_gentrace && !f4 ) {
4170: tl2 = nd_alltracelist; nd_alltracelist = 0;
4171: ndv_check_membership(m,fd0,obpe,oadv,oepos,x);
4172: tl3 = nd_alltracelist; nd_alltracelist = 0;
4173: if ( nd_gensyz ) {
4174: nd_gb(m,0,1,1,0);
4175: tl4 = nd_alltracelist; nd_alltracelist = 0;
4176: } else tl4 = 0;
4177: }
4178: nd_bpe = cbpe;
4179: nd_setup_parameters(nd_nvar,0);
4180: FINAL:
4181: for ( r0 = 0, t = x; t; t = NEXT(t) ) {
1.16 noro 4182: NEXTNODE(r0,r);
4183: if ( nd_module ) {
4184: if ( retdp ) BDY(r) = ndvtodpm(m,BDY(t));
4185: else BDY(r) = ndvtopl(m,CO,vv,BDY(t),mrank);
4186: } else if ( retdp ) BDY(r) = ndvtodp(m,BDY(t));
4187: else BDY(r) = ndvtop(m,CO,vv,BDY(t));
1.1 noro 4188: }
4189: if ( r0 ) NEXT(r) = 0;
4190: if ( !m && nd_nalg )
4191: r0 = postprocess_algcoef(av,alist,r0);
4192: MKLIST(*rp,r0);
4193: if ( nd_gentrace ) {
4194: if ( f4 ) {
1.6 noro 4195: STOZ(16,bpe);
4196: STOZ(nd_last_nonzero,last_nonzero);
1.15 noro 4197: tr = mknode(6,*rp,(!ishomo&&homo)?ONE:0,BDY(nzlist),bpe,last_nonzero,hvect); MKLIST(*rp,tr);
1.1 noro 4198: } else {
4199: tl1 = reverse_node(tl1); tl2 = reverse_node(tl2);
4200: tl3 = reverse_node(tl3);
4201: /* tl2 = [[i,[[*,j,*,*],...]],...] */
4202: for ( t = tl2; t; t = NEXT(t) ) {
4203: /* s = [i,[*,j,*,*],...] */
4204: s = BDY((LIST)BDY(t));
1.6 noro 4205: j = perm[ZTOS((Q)ARG0(s))]; STOZ(j,jq); ARG0(s) = (pointer)jq;
1.1 noro 4206: for ( s = BDY((LIST)ARG1(s)); s; s = NEXT(s) ) {
1.6 noro 4207: j = perm[ZTOS((Q)ARG1(BDY((LIST)BDY(s))))]; STOZ(j,jq);
1.1 noro 4208: ARG1(BDY((LIST)BDY(s))) = (pointer)jq;
4209: }
4210: }
4211: for ( j = length(x)-1, t = 0; j >= 0; j-- ) {
1.6 noro 4212: STOZ(perm[j],jq); MKNODE(s,jq,t); t = s;
1.1 noro 4213: }
4214: MKLIST(l1,tl1); MKLIST(l2,tl2); MKLIST(l3,t); MKLIST(l4,tl3);
4215: MKLIST(l5,tl4);
1.6 noro 4216: STOZ(nd_bpe,bpe);
1.15 noro 4217: tr = mknode(9,*rp,(!ishomo&&homo)?ONE:0,l1,l2,l3,l4,l5,bpe,hvect); MKLIST(*rp,tr);
1.1 noro 4218: }
4219: }
4220: #if 0
4221: fprintf(asir_out,"ndv_alloc=%d\n",ndv_alloc);
4222: #endif
4223: }
4224:
1.24 noro 4225: void nd_sba(LIST f,LIST v,int m,int homo,int retdp,struct order_spec *ord,LIST *rp)
4226: {
4227: VL tv,fv,vv,vc,av;
4228: NODE fd,fd0,r,r0,t,x,s,xx;
4229: int e,max,nvar,i;
4230: NDV b;
4231: int ishomo,nalg,wmax,len;
4232: NMV a;
4233: P p,zp;
4234: Q dmy;
4235: struct order_spec *ord1;
4236: int j;
4237: int *perm;
4238: EPOS oepos;
4239: int obpe,oadv,ompos,cbpe;
4240:
4241: nd_module = 0;
4242: nd_demand = 0;
4243: parse_nd_option(current_option);
4244:
4245: if ( DP_Multiple )
4246: nd_scale = ((double)DP_Multiple)/(double)(Denominator?Denominator:1);
4247: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
4248: if ( m && nd_vc )
4249: error("nd_sba : computation over Fp(X) is unsupported. Use dp_gr_mod_main().");
4250: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
4251: switch ( ord->id ) {
4252: case 1:
4253: if ( ord->nv != nvar )
4254: error("nd_sba : invalid order specification");
4255: break;
4256: default:
4257: break;
4258: }
4259: nd_nalg = 0;
4260: nd_init_ord(ord);
4261: // for SIG comparison
4262: initd(ord);
4263: for ( t = BDY(f), max = 1; t; t = NEXT(t) ) {
4264: for ( tv = vv; tv; tv = NEXT(tv) ) {
4265: e = getdeg(tv->v,(P)BDY(t));
4266: max = MAX(e,max);
4267: }
4268: }
1.25 ! noro 4269: nd_setup_parameters(nvar,max);
1.24 noro 4270: obpe = nd_bpe; oadv = nmv_adv; oepos = nd_epos; ompos = nd_mpos;
4271: ishomo = 1;
4272: for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
4273: if ( !m ) ptozp((P)BDY(t),1,&dmy,&zp);
4274: else zp = (P)BDY(t);
4275: b = (pointer)ptondv(CO,vv,zp);
4276: if ( ishomo )
4277: ishomo = ishomo && ndv_ishomo(b);
4278: if ( m ) ndv_mod(m,b);
4279: if ( b ) { NEXTNODE(fd0,fd); BDY(fd) = (pointer)b; }
4280: }
4281: if ( fd0 ) NEXT(fd) = 0;
4282:
4283: if ( !ishomo && homo ) {
4284: for ( t = fd0, wmax = max; t; t = NEXT(t) ) {
4285: b = (NDV)BDY(t); len = LEN(b);
4286: for ( a = BDY(b), i = 0; i < len; i++, NMV_ADV(a) )
4287: wmax = MAX(TD(DL(a)),wmax);
4288: }
4289: homogenize_order(ord,nvar,&ord1);
4290: nd_init_ord(ord1);
4291: nd_setup_parameters(nvar+1,nd_nzlist?0:wmax);
4292: for ( t = fd0; t; t = NEXT(t) )
4293: ndv_homogenize((NDV)BDY(t),obpe,oadv,oepos,ompos);
4294: }
4295:
4296: ndv_setup(m,0,fd0,0,0,1);
4297: x = nd_sba_buch(m,ishomo || homo,&perm);
4298: if ( !x ) {
4299: *rp = 0; return;
4300: }
4301: if ( !ishomo && homo ) {
4302: /* dehomogenization */
4303: for ( t = x; t; t = NEXT(t) ) ndv_dehomogenize((NDV)BDY(t),ord);
4304: nd_init_ord(ord);
4305: nd_setup_parameters(nvar,0);
4306: }
4307: nd_demand = 0;
4308: x = ndv_reducebase(x,perm);
4309: x = ndv_reduceall(m,x);
4310: nd_setup_parameters(nd_nvar,0);
4311: for ( r0 = 0, t = x; t; t = NEXT(t) ) {
4312: NEXTNODE(r0,r);
4313: if ( retdp ) BDY(r) = ndvtodp(m,BDY(t));
4314: BDY(r) = ndvtop(m,CO,vv,BDY(t));
4315: }
4316: if ( r0 ) NEXT(r) = 0;
4317: MKLIST(*rp,r0);
4318: }
4319:
1.1 noro 4320: void nd_gr_postproc(LIST f,LIST v,int m,struct order_spec *ord,int do_check,LIST *rp)
4321: {
4322: VL tv,fv,vv,vc,av;
4323: NODE fd,fd0,r,r0,t,x,s,xx,alist;
4324: int e,max,nvar,i;
4325: NDV b;
4326: int ishomo,nalg;
4327: Alg alpha,dp;
4328: P p,zp;
4329: Q dmy;
4330: LIST f1,f2;
4331: Obj obj;
4332: NumberField nf;
4333: struct order_spec *ord1;
4334: int *perm;
4335:
4336: parse_nd_option(current_option);
4337: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
4338: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
4339: switch ( ord->id ) {
4340: case 1:
4341: if ( ord->nv != nvar )
4342: error("nd_check : invalid order specification");
4343: break;
4344: default:
4345: break;
4346: }
4347: nd_nalg = 0;
4348: av = 0;
4349: if ( !m ) {
4350: get_algtree((Obj)f,&av);
4351: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++ );
4352: nd_ntrans = nvar;
4353: nd_nalg = nalg;
4354: /* #i -> t#i */
4355: if ( nalg ) {
4356: preprocess_algcoef(vv,av,ord,f,&ord1,&f1,&alist);
4357: ord = ord1;
4358: f = f1;
4359: }
4360: nvar += nalg;
4361: }
4362: nd_init_ord(ord);
4363: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
4364: for ( tv = vv; tv; tv = NEXT(tv) ) {
4365: e = getdeg(tv->v,(P)BDY(t));
4366: max = MAX(e,max);
4367: }
4368: nd_setup_parameters(nvar,max);
4369: ishomo = 1;
4370: for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
4371: ptozp((P)BDY(t),1,&dmy,&zp);
4372: b = (pointer)ptondv(CO,vv,zp);
4373: if ( ishomo )
4374: ishomo = ishomo && ndv_ishomo(b);
4375: if ( m ) ndv_mod(m,b);
4376: if ( b ) { NEXTNODE(fd0,fd); BDY(fd) = (pointer)b; }
4377: }
4378: if ( fd0 ) NEXT(fd) = 0;
1.24 noro 4379: ndv_setup(m,0,fd0,0,1,0);
1.1 noro 4380: for ( x = 0, i = 0; i < nd_psn; i++ )
4381: x = update_base(x,i);
4382: if ( do_check ) {
4383: x = nd_gb(m,ishomo,1,0,&perm);
4384: if ( !x ) {
4385: *rp = 0;
4386: return;
4387: }
4388: } else {
4389: #if 0
4390: /* bug ? */
4391: for ( t = x; t; t = NEXT(t) )
4392: BDY(t) = (pointer)nd_ps[(long)BDY(t)];
4393: #else
4394: conv_ilist(0,0,x,&perm);
4395: #endif
4396: }
4397: x = ndv_reducebase(x,perm);
4398: x = ndv_reduceall(m,x);
4399: for ( r0 = 0, t = x; t; t = NEXT(t) ) {
4400: NEXTNODE(r0,r);
4401: BDY(r) = ndvtop(m,CO,vv,BDY(t));
4402: }
4403: if ( r0 ) NEXT(r) = 0;
4404: if ( !m && nd_nalg )
4405: r0 = postprocess_algcoef(av,alist,r0);
4406: MKLIST(*rp,r0);
4407: }
4408:
4409: NDV recompute_trace(NODE trace,NDV *p,int m);
4410: void nd_gr_recompute_trace(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,LIST *rp);
4411:
4412: NDV recompute_trace(NODE ti,NDV *p,int mod)
4413: {
4414: int c,c1,c2,i;
4415: NM mul,m,tail;
4416: ND d,r,rm;
4417: NODE sj;
4418: NDV red;
4419: Obj mj;
4420:
4421: mul = (NM)MALLOC(sizeof(struct oNM)+(nd_wpd-1)*sizeof(UINT));
4422: CM(mul) = 1;
4423: tail = 0;
4424: for ( i = 0, d = r = 0; ti; ti = NEXT(ti), i++ ) {
4425: sj = BDY((LIST)BDY(ti));
4426: if ( ARG0(sj) ) {
1.6 noro 4427: red = p[ZTOS((Q)ARG1(sj))];
1.1 noro 4428: mj = (Obj)ARG2(sj);
4429: if ( OID(mj) != O_DP ) ndl_zero(DL(mul));
4430: else dltondl(nd_nvar,BDY((DP)mj)->dl,DL(mul));
4431: rm = ndv_mul_nm(mod,mul,red);
4432: if ( !r ) r = rm;
4433: else {
4434: for ( m = BDY(r); m && !ndl_equal(m->dl,BDY(rm)->dl); m = NEXT(m), LEN(r)-- ) {
4435: if ( d ) {
4436: NEXT(tail) = m; tail = m; LEN(d)++;
4437: } else {
4438: MKND(nd_nvar,m,1,d); tail = BDY(d);
4439: }
4440: }
4441: if ( !m ) return 0; /* failure */
4442: else {
4443: BDY(r) = m;
4444: if ( mod > 0 || mod == -1 ) {
4445: c1 = invm(HCM(rm),mod); c2 = mod-HCM(r);
4446: DMAR(c1,c2,0,mod,c);
4447: nd_mul_c(mod,rm,c);
4448: } else {
4449: Z t,u;
4450:
4451: chsgnlf(HCZ(r),&t);
4452: divlf(t,HCZ(rm),&u);
4453: nd_mul_c_lf(rm,u);
4454: }
4455: r = nd_add(mod,r,rm);
4456: }
4457: }
4458: }
4459: }
4460: if ( tail ) NEXT(tail) = 0;
4461: d = nd_add(mod,d,r);
4462: nd_mul_c(mod,d,invm(HCM(d),mod));
4463: return ndtondv(mod,d);
4464: }
4465:
4466: void nd_gr_recompute_trace(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,LIST *rp)
4467: {
4468: VL tv,fv,vv,vc,av;
4469: NODE fd,fd0,r,r0,t,x,s,xx,alist;
4470: int e,max,nvar,i;
4471: NDV b;
4472: int ishomo,nalg;
4473: Alg alpha,dp;
4474: P p,zp;
4475: Q dmy;
4476: LIST f1,f2;
4477: Obj obj;
4478: NumberField nf;
4479: struct order_spec *ord1;
4480: NODE permtrace,intred,ind,perm,trace,ti;
4481: int len,n,j;
4482: NDV *db,*pb;
4483:
4484: parse_nd_option(current_option);
4485: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
4486: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
4487: switch ( ord->id ) {
4488: case 1:
4489: if ( ord->nv != nvar )
4490: error("nd_check : invalid order specification");
4491: break;
4492: default:
4493: break;
4494: }
4495: nd_init_ord(ord);
1.6 noro 4496: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 4497: nd_setup_parameters(nvar,0);
4498:
4499: len = length(BDY(f));
4500: db = (NDV *)MALLOC(len*sizeof(NDV *));
4501: for ( i = 0, t = BDY(f); t; i++, t = NEXT(t) ) {
4502: ptozp((P)BDY(t),1,&dmy,&zp);
4503: b = ptondv(CO,vv,zp);
4504: ndv_mod(m,b);
4505: ndv_mul_c(m,b,invm(HCM(b),m));
4506: db[i] = b;
4507: }
4508:
4509: permtrace = BDY((LIST)ARG2(BDY(tlist)));
4510: intred = BDY((LIST)ARG3(BDY(tlist)));
4511: ind = BDY((LIST)ARG4(BDY(tlist)));
4512: perm = BDY((LIST)ARG0(permtrace));
4513: trace = NEXT(permtrace);
4514:
4515: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 4516: j = ZTOS((Q)ARG0(BDY((LIST)BDY(t))));
1.1 noro 4517: if ( j > i ) i = j;
4518: }
4519: n = i+1;
4520: pb = (NDV *)MALLOC(n*sizeof(NDV *));
4521: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
4522: ti = BDY((LIST)BDY(t));
1.6 noro 4523: pb[ZTOS((Q)ARG0(ti))] = db[ZTOS((Q)ARG1(ti))];
1.1 noro 4524: }
4525: for ( t = trace; t; t = NEXT(t) ) {
4526: ti = BDY((LIST)BDY(t));
1.6 noro 4527: pb[ZTOS((Q)ARG0(ti))] = recompute_trace(BDY((LIST)ARG1(ti)),pb,m);
4528: if ( !pb[ZTOS((Q)ARG0(ti))] ) { *rp = 0; return; }
1.1 noro 4529: if ( DP_Print ) {
4530: fprintf(asir_out,"."); fflush(asir_out);
4531: }
4532: }
4533: for ( t = intred; t; t = NEXT(t) ) {
4534: ti = BDY((LIST)BDY(t));
1.6 noro 4535: pb[ZTOS((Q)ARG0(ti))] = recompute_trace(BDY((LIST)ARG1(ti)),pb,m);
4536: if ( !pb[ZTOS((Q)ARG0(ti))] ) { *rp = 0; return; }
1.1 noro 4537: if ( DP_Print ) {
4538: fprintf(asir_out,"*"); fflush(asir_out);
4539: }
4540: }
4541: for ( r0 = 0, t = ind; t; t = NEXT(t) ) {
4542: NEXTNODE(r0,r);
1.6 noro 4543: b = pb[ZTOS((Q)BDY(t))];
1.1 noro 4544: ndv_mul_c(m,b,invm(HCM(b),m));
4545: #if 0
1.6 noro 4546: BDY(r) = ndvtop(m,CO,vv,pb[ZTOS((Q)BDY(t))]);
1.1 noro 4547: #else
1.6 noro 4548: BDY(r) = ndvtodp(m,pb[ZTOS((Q)BDY(t))]);
1.1 noro 4549: #endif
4550: }
4551: if ( r0 ) NEXT(r) = 0;
4552: MKLIST(*rp,r0);
4553: if ( DP_Print ) fprintf(asir_out,"\n");
4554: }
4555:
1.16 noro 4556: 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 4557: {
4558: VL tv,fv,vv,vc,av;
4559: NODE fd,fd0,in0,in,r,r0,t,s,cand,alist;
4560: int m,nocheck,nvar,mindex,e,max;
4561: NDV c;
4562: NMV a;
4563: P p,zp;
4564: Q dmy;
4565: EPOS oepos;
4566: int obpe,oadv,wmax,i,len,cbpe,ishomo,nalg,mrank,trank,ompos;
4567: Alg alpha,dp;
4568: P poly;
4569: LIST f1,f2,zpl;
4570: Obj obj;
4571: NumberField nf;
4572: struct order_spec *ord1;
4573: struct oEGT eg_check,eg0,eg1;
4574: NODE tr,tl1,tl2,tl3,tl4;
4575: LIST l1,l2,l3,l4,l5;
4576: int *perm;
4577: int j,ret;
4578: Z jq,bpe;
1.15 noro 4579: VECT hvect;
1.1 noro 4580:
4581: nd_module = 0;
4582: nd_lf = 0;
4583: parse_nd_option(current_option);
4584: if ( nd_lf ) {
4585: if ( f4 )
4586: nd_f4_lf_trace(f,v,trace,homo,ord,rp);
4587: else
4588: error("nd_gr_trace is not implemented yet over a large finite field");
4589: return;
4590: }
4591: if ( DP_Multiple )
4592: nd_scale = ((double)DP_Multiple)/(double)(Denominator?Denominator:1);
4593:
4594: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
4595: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
4596: switch ( ord->id ) {
4597: case 1:
4598: if ( ord->nv != nvar )
4599: error("nd_gr_trace : invalid order specification");
4600: break;
4601: default:
4602: break;
4603: }
4604:
4605: get_algtree((Obj)f,&av);
4606: for ( nalg = 0, tv = av; tv; tv = NEXT(tv), nalg++ );
4607: nd_ntrans = nvar;
4608: nd_nalg = nalg;
4609: /* #i -> t#i */
4610: if ( nalg ) {
4611: preprocess_algcoef(vv,av,ord,f,&ord1,&f1,&alist);
4612: ord = ord1;
4613: f = f1;
4614: }
4615: nvar += nalg;
4616:
4617: nocheck = 0;
4618: mindex = 0;
4619:
4620: if ( Demand ) nd_demand = 1;
4621: else nd_demand = 0;
4622:
4623: /* setup modulus */
4624: if ( trace < 0 ) {
4625: trace = -trace;
4626: nocheck = 1;
4627: }
4628: m = trace > 1 ? trace : get_lprime(mindex);
4629: nd_init_ord(ord);
4630: mrank = 0;
4631: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
4632: for ( tv = vv; tv; tv = NEXT(tv) ) {
4633: if ( nd_module ) {
1.16 noro 4634: if ( OID(BDY(t)) == O_DPM ) {
4635: e = dpm_getdeg((DPM)BDY(t),&trank);
4636: max = MAX(e,max);
4637: mrank = MAX(mrank,trank);
4638: } else {
1.1 noro 4639: s = BDY((LIST)BDY(t));
4640: trank = length(s);
4641: mrank = MAX(mrank,trank);
4642: for ( ; s; s = NEXT(s) ) {
4643: e = getdeg(tv->v,(P)BDY(s));
4644: max = MAX(e,max);
4645: }
1.16 noro 4646: }
1.1 noro 4647: } else {
4648: e = getdeg(tv->v,(P)BDY(t));
4649: max = MAX(e,max);
4650: }
4651: }
4652: nd_setup_parameters(nvar,max);
4653: obpe = nd_bpe; oadv = nmv_adv; oepos = nd_epos; ompos = nd_mpos;
4654: ishomo = 1;
4655: for ( in0 = 0, fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
4656: if ( nd_module ) {
1.16 noro 4657: if ( OID(BDY(t)) == O_DPM ) {
4658: Z cont;
4659: DPM zdpm;
4660:
1.17 noro 4661: if ( !nd_gentrace ) dpm_ptozp((DPM)BDY(t),&cont,&zdpm);
1.16 noro 4662: else zdpm = (DPM)BDY(t);
4663: c = (pointer)dpmtondv(m,zdpm);
4664: } else {
4665: if ( !nd_gentrace ) pltozpl((LIST)BDY(t),&dmy,&zpl);
4666: else zpl = (LIST)BDY(t);
1.1 noro 4667: c = (pointer)pltondv(CO,vv,zpl);
1.16 noro 4668: }
1.1 noro 4669: } else {
1.16 noro 4670: if ( !nd_gentrace ) ptozp((P)BDY(t),1,&dmy,&zp);
4671: else zp = (P)BDY(t);
4672: c = (pointer)ptondv(CO,vv,zp);
1.1 noro 4673: }
4674: if ( ishomo )
4675: ishomo = ishomo && ndv_ishomo(c);
4676: if ( c ) {
4677: NEXTNODE(in0,in); BDY(in) = (pointer)c;
4678: NEXTNODE(fd0,fd); BDY(fd) = (pointer)ndv_dup(0,c);
4679: }
4680: }
4681: if ( in0 ) NEXT(in) = 0;
4682: if ( fd0 ) NEXT(fd) = 0;
4683: if ( !ishomo && homo ) {
4684: for ( t = in0, wmax = max; t; t = NEXT(t) ) {
4685: c = (NDV)BDY(t); len = LEN(c);
4686: for ( a = BDY(c), i = 0; i < len; i++, NMV_ADV(a) )
4687: wmax = MAX(TD(DL(a)),wmax);
4688: }
4689: homogenize_order(ord,nvar,&ord1);
4690: nd_init_ord(ord1);
4691: nd_setup_parameters(nvar+1,wmax);
4692: for ( t = fd0; t; t = NEXT(t) )
4693: ndv_homogenize((NDV)BDY(t),obpe,oadv,oepos,ompos);
4694: }
4695: if ( MaxDeg > 0 ) nocheck = 1;
4696: while ( 1 ) {
4697: tl1 = tl2 = tl3 = tl4 = 0;
4698: if ( Demand )
4699: nd_demand = 1;
1.24 noro 4700: ret = ndv_setup(m,1,fd0,nd_gbblock?1:0,0,0);
1.1 noro 4701: if ( nd_gentrace ) {
4702: MKLIST(l1,nd_tracelist); MKNODE(nd_alltracelist,l1,0);
4703: }
4704: if ( ret )
4705: cand = f4?nd_f4_trace(m,&perm):nd_gb_trace(m,ishomo || homo,&perm);
4706: if ( !ret || !cand ) {
4707: /* failure */
4708: if ( trace > 1 ) { *rp = 0; return; }
4709: else m = get_lprime(++mindex);
4710: continue;
4711: }
1.15 noro 4712: if ( nd_gentrace ) {
4713: MKVECT(hvect,nd_psn);
4714: for ( i = 0; i < nd_psn; i++ )
4715: ndltodp(nd_psh[i]->dl,(DP *)&BDY(hvect)[i]);
4716: }
1.1 noro 4717: if ( !ishomo && homo ) {
4718: /* dehomogenization */
4719: for ( t = cand; t; t = NEXT(t) ) ndv_dehomogenize((NDV)BDY(t),ord);
4720: nd_init_ord(ord);
4721: nd_setup_parameters(nvar,0);
4722: }
4723: nd_demand = 0;
4724: cand = ndv_reducebase(cand,perm);
4725: if ( nd_gentrace ) { tl1 = nd_alltracelist; nd_alltracelist = 0; }
4726: cand = ndv_reduceall(0,cand);
4727: cbpe = nd_bpe;
4728: if ( nd_gentrace ) { tl2 = nd_alltracelist; nd_alltracelist = 0; }
4729: get_eg(&eg0);
4730: if ( nocheck )
4731: break;
4732: if ( (ret = ndv_check_membership(0,in0,obpe,oadv,oepos,cand)) != 0 ) {
4733: if ( nd_gentrace ) {
4734: tl3 = nd_alltracelist; nd_alltracelist = 0;
4735: } else tl3 = 0;
4736: /* gbcheck : cand is a GB of Id(cand) ? */
4737: if ( nd_vc || nd_gentrace || nd_gensyz )
4738: ret = nd_gb(0,0,1,nd_gensyz?1:0,0)!=0;
4739: else
4740: ret = nd_f4(0,1,0)!=0;
4741: if ( nd_gentrace && nd_gensyz ) {
4742: tl4 = nd_alltracelist; nd_alltracelist = 0;
4743: } else tl4 = 0;
4744: }
4745: if ( ret ) break;
4746: else if ( trace > 1 ) {
4747: /* failure */
4748: *rp = 0; return;
4749: } else {
4750: /* try the next modulus */
4751: m = get_lprime(++mindex);
4752: /* reset the parameters */
4753: if ( !ishomo && homo ) {
4754: nd_init_ord(ord1);
4755: nd_setup_parameters(nvar+1,wmax);
4756: } else {
4757: nd_init_ord(ord);
4758: nd_setup_parameters(nvar,max);
4759: }
4760: }
4761: }
4762: get_eg(&eg1); init_eg(&eg_check); add_eg(&eg_check,&eg0,&eg1);
4763: if ( DP_Print )
1.6 noro 4764: fprintf(asir_out,"check=%.3fsec\n",eg_check.exectime);
1.1 noro 4765: /* dp->p */
4766: nd_bpe = cbpe;
4767: nd_setup_parameters(nd_nvar,0);
4768: for ( r = cand; r; r = NEXT(r) ) {
1.16 noro 4769: if ( nd_module ) {
1.17 noro 4770: if ( retdp ) BDY(r) = ndvtodpm(0,BDY(r));
1.16 noro 4771: else BDY(r) = ndvtopl(0,CO,vv,BDY(r),mrank);
1.17 noro 4772: } else if ( retdp ) BDY(r) = ndvtodp(0,BDY(r));
4773: else BDY(r) = (pointer)ndvtop(0,CO,vv,BDY(r));
1.1 noro 4774: }
4775: if ( nd_nalg )
4776: cand = postprocess_algcoef(av,alist,cand);
4777: MKLIST(*rp,cand);
4778: if ( nd_gentrace ) {
4779: tl1 = reverse_node(tl1); tl2 = reverse_node(tl2);
4780: tl3 = reverse_node(tl3);
4781: /* tl2 = [[i,[[*,j,*,*],...]],...] */
4782: for ( t = tl2; t; t = NEXT(t) ) {
4783: /* s = [i,[*,j,*,*],...] */
4784: s = BDY((LIST)BDY(t));
1.6 noro 4785: j = perm[ZTOS((Q)ARG0(s))]; STOZ(j,jq); ARG0(s) = (pointer)jq;
1.1 noro 4786: for ( s = BDY((LIST)ARG1(s)); s; s = NEXT(s) ) {
1.6 noro 4787: j = perm[ZTOS((Q)ARG1(BDY((LIST)BDY(s))))]; STOZ(j,jq);
1.1 noro 4788: ARG1(BDY((LIST)BDY(s))) = (pointer)jq;
4789: }
4790: }
4791: for ( j = length(cand)-1, t = 0; j >= 0; j-- ) {
1.6 noro 4792: STOZ(perm[j],jq); MKNODE(s,jq,t); t = s;
1.1 noro 4793: }
4794: MKLIST(l1,tl1); MKLIST(l2,tl2); MKLIST(l3,t); MKLIST(l4,tl3);
4795: MKLIST(l5,tl4);
1.6 noro 4796: STOZ(nd_bpe,bpe);
1.15 noro 4797: tr = mknode(9,*rp,(!ishomo&&homo)?ONE:0,l1,l2,l3,l4,l5,bpe,hvect); MKLIST(*rp,tr);
1.1 noro 4798: }
4799: }
4800:
4801: /* XXX : module element is not considered */
4802:
4803: void dltondl(int n,DL dl,UINT *r)
4804: {
4805: UINT *d;
4806: int i,j,l,s,ord_l;
4807: struct order_pair *op;
4808:
4809: d = (unsigned int *)dl->d;
4810: for ( i = 0; i < nd_wpd; i++ ) r[i] = 0;
4811: if ( nd_blockmask ) {
4812: l = nd_blockmask->n;
4813: op = nd_blockmask->order_pair;
4814: for ( j = 0, s = 0; j < l; j++ ) {
4815: ord_l = op[j].length;
4816: for ( i = 0; i < ord_l; i++, s++ ) PUT_EXP(r,s,d[s]);
4817: }
4818: TD(r) = ndl_weight(r);
4819: ndl_weight_mask(r);
4820: } else {
4821: for ( i = 0; i < n; i++ ) PUT_EXP(r,i,d[i]);
4822: TD(r) = ndl_weight(r);
4823: }
4824: }
4825:
4826: DL ndltodl(int n,UINT *ndl)
4827: {
4828: DL dl;
4829: int *d;
4830: int i,j,l,s,ord_l;
4831: struct order_pair *op;
4832:
4833: NEWDL(dl,n);
4834: dl->td = TD(ndl);
4835: d = dl->d;
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++ ) d[s] = GET_EXP(ndl,s);
4842: }
4843: } else {
4844: for ( i = 0; i < n; i++ ) d[i] = GET_EXP(ndl,i);
4845: }
4846: return dl;
4847: }
4848:
1.24 noro 4849: void _ndltodl(UINT *ndl,DL dl)
4850: {
4851: int *d;
4852: int i,j,l,s,ord_l,n;
4853: struct order_pair *op;
4854:
4855: n = nd_nvar;
4856: dl->td = TD(ndl);
4857: d = dl->d;
4858: if ( nd_blockmask ) {
4859: l = nd_blockmask->n;
4860: op = nd_blockmask->order_pair;
4861: for ( j = 0, s = 0; j < l; j++ ) {
4862: ord_l = op[j].length;
4863: for ( i = 0; i < ord_l; i++, s++ ) d[s] = GET_EXP(ndl,s);
4864: }
4865: } else {
4866: for ( i = 0; i < n; i++ ) d[i] = GET_EXP(ndl,i);
4867: }
4868: }
4869:
1.1 noro 4870: void nmtodp(int mod,NM m,DP *r)
4871: {
4872: DP dp;
4873: MP mr;
4874:
4875: NEWMP(mr);
4876: mr->dl = ndltodl(nd_nvar,DL(m));
4877: mr->c = (Obj)ndctop(mod,m->c);
4878: NEXT(mr) = 0; MKDP(nd_nvar,mr,dp); dp->sugar = mr->dl->td;
4879: *r = dp;
4880: }
4881:
1.15 noro 4882: void ndltodp(UINT *d,DP *r)
4883: {
4884: DP dp;
4885: MP mr;
4886:
4887: NEWMP(mr);
4888: mr->dl = ndltodl(nd_nvar,d);
4889: mr->c = (Obj)ONE;
4890: NEXT(mr) = 0; MKDP(nd_nvar,mr,dp); dp->sugar = mr->dl->td;
4891: *r = dp;
4892: }
4893:
1.1 noro 4894: void ndl_print(UINT *dl)
4895: {
4896: int n;
4897: int i,j,l,ord_l,s,s0;
4898: struct order_pair *op;
4899:
4900: n = nd_nvar;
4901: printf("<<");
4902: if ( nd_blockmask ) {
4903: l = nd_blockmask->n;
4904: op = nd_blockmask->order_pair;
4905: for ( j = 0, s = s0 = 0; j < l; j++ ) {
4906: ord_l = op[j].length;
4907: for ( i = 0; i < ord_l; i++, s++ )
4908: printf(s==n-1?"%d":"%d,",GET_EXP(dl,s));
4909: }
4910: } else {
4911: for ( i = 0; i < n; i++ ) printf(i==n-1?"%d":"%d,",GET_EXP(dl,i));
4912: }
4913: printf(">>");
4914: if ( nd_module && MPOS(dl) )
4915: printf("*e%d",MPOS(dl));
4916: }
4917:
4918: void nd_print(ND p)
4919: {
4920: NM m;
4921:
4922: if ( !p )
4923: printf("0\n");
4924: else {
4925: for ( m = BDY(p); m; m = NEXT(m) ) {
4926: if ( CM(m) & 0x80000000 ) printf("+@_%d*",IFTOF(CM(m)));
4927: else printf("+%d*",CM(m));
4928: ndl_print(DL(m));
4929: }
4930: printf("\n");
4931: }
4932: }
4933:
4934: void nd_print_q(ND p)
4935: {
4936: NM m;
4937:
4938: if ( !p )
4939: printf("0\n");
4940: else {
4941: for ( m = BDY(p); m; m = NEXT(m) ) {
4942: printf("+");
1.6 noro 4943: printexpr(CO,(Obj)CZ(m));
1.1 noro 4944: printf("*");
4945: ndl_print(DL(m));
4946: }
4947: printf("\n");
4948: }
4949: }
4950:
4951: void ndp_print(ND_pairs d)
4952: {
4953: ND_pairs t;
4954:
4955: for ( t = d; t; t = NEXT(t) ) printf("%d,%d ",t->i1,t->i2);
4956: printf("\n");
4957: }
4958:
4959: void nd_removecont(int mod,ND p)
4960: {
4961: int i,n;
4962: Z *w;
4963: NM m;
4964: struct oVECT v;
4965:
4966: if ( mod == -1 ) nd_mul_c(mod,p,_invsf(HCM(p)));
4967: else if ( mod == -2 ) {
4968: Z inv;
4969: divlf(ONE,HCZ(p),&inv);
4970: nd_mul_c_lf(p,inv);
4971: } else if ( mod ) nd_mul_c(mod,p,invm(HCM(p),mod));
4972: else {
4973: for ( m = BDY(p), n = 0; m; m = NEXT(m), n++ );
4974: w = (Z *)MALLOC(n*sizeof(Q));
4975: v.len = n;
4976: v.body = (pointer *)w;
1.6 noro 4977: for ( m = BDY(p), i = 0; i < n; m = NEXT(m), i++ ) w[i] = CZ(m);
1.1 noro 4978: removecont_array((P *)w,n,1);
1.6 noro 4979: for ( m = BDY(p), i = 0; i < n; m = NEXT(m), i++ ) CZ(m) = w[i];
1.1 noro 4980: }
4981: }
4982:
4983: void nd_removecont2(ND p1,ND p2)
4984: {
4985: int i,n1,n2,n;
4986: Z *w;
4987: NM m;
4988: struct oVECT v;
4989:
4990: n1 = nd_length(p1);
4991: n2 = nd_length(p2);
4992: n = n1+n2;
4993: w = (Z *)MALLOC(n*sizeof(Q));
4994: v.len = n;
4995: v.body = (pointer *)w;
4996: i = 0;
4997: if ( p1 )
1.6 noro 4998: for ( m = BDY(p1); i < n1; m = NEXT(m), i++ ) w[i] = CZ(m);
1.1 noro 4999: if ( p2 )
1.6 noro 5000: for ( m = BDY(p2); i < n; m = NEXT(m), i++ ) w[i] = CZ(m);
1.1 noro 5001: removecont_array((P *)w,n,1);
5002: i = 0;
5003: if ( p1 )
1.6 noro 5004: for ( m = BDY(p1); i < n1; m = NEXT(m), i++ ) CZ(m) = w[i];
1.1 noro 5005: if ( p2 )
1.6 noro 5006: for ( m = BDY(p2); i < n; m = NEXT(m), i++ ) CZ(m) = w[i];
1.1 noro 5007: }
5008:
5009: void ndv_removecont(int mod,NDV p)
5010: {
5011: int i,len,all_p;
5012: Z *c;
5013: P *w;
5014: Z dvr,t;
5015: P g,cont,tp;
5016: NMV m;
5017:
5018: if ( mod == -1 )
5019: ndv_mul_c(mod,p,_invsf(HCM(p)));
5020: else if ( mod == -2 ) {
5021: Z inv;
5022: divlf(ONE,HCZ(p),&inv);
5023: ndv_mul_c_lf(p,inv);
5024: } else if ( mod )
5025: ndv_mul_c(mod,p,invm(HCM(p),mod));
5026: else {
5027: len = p->len;
5028: w = (P *)MALLOC(len*sizeof(P));
5029: c = (Z *)MALLOC(len*sizeof(Q));
5030: for ( m = BDY(p), all_p = 1, i = 0; i < len; NMV_ADV(m), i++ ) {
5031: ptozp(CP(m),1,(Q *)&c[i],&w[i]);
5032: all_p = all_p && !NUM(w[i]);
5033: }
5034: if ( all_p ) {
5035: qltozl((Q *)c,len,&dvr); nd_heu_nezgcdnpz(nd_vc,w,len,1,&g);
5036: mulp(nd_vc,(P)dvr,g,&cont);
5037: for ( m = BDY(p), i = 0; i < len; NMV_ADV(m), i++ ) {
5038: divsp(nd_vc,CP(m),cont,&tp); CP(m) = tp;
5039: }
5040: } else {
5041: sortbynm((Q *)c,len);
5042: qltozl((Q *)c,len,&dvr);
5043: for ( m = BDY(p), i = 0; i < len; NMV_ADV(m), i++ ) {
5044: divsp(nd_vc,CP(m),(P)dvr,&tp); CP(m) = tp;
5045: }
5046: }
5047: }
5048: }
5049:
5050: /* koko */
5051:
5052: void ndv_homogenize(NDV p,int obpe,int oadv,EPOS oepos,int ompos)
5053: {
5054: int len,i,max;
5055: NMV m,mr0,mr,t;
5056:
5057: len = p->len;
1.14 noro 5058: for ( m = BDY(p), i = 0, max = 0; i < len; NMV_OADV(m), i++ )
1.1 noro 5059: max = MAX(max,TD(DL(m)));
5060: mr0 = nmv_adv>oadv?(NMV)REALLOC(BDY(p),len*nmv_adv):BDY(p);
5061: m = (NMV)((char *)mr0+(len-1)*oadv);
5062: mr = (NMV)((char *)mr0+(len-1)*nmv_adv);
5063: t = (NMV)MALLOC(nmv_adv);
5064: for ( i = 0; i < len; i++, NMV_OPREV(m), NMV_PREV(mr) ) {
5065: ndl_homogenize(DL(m),DL(t),obpe,oepos,ompos,max);
1.6 noro 5066: CZ(mr) = CZ(m);
1.1 noro 5067: ndl_copy(DL(t),DL(mr));
5068: }
5069: NV(p)++;
5070: BDY(p) = mr0;
5071: }
5072:
5073: void ndv_dehomogenize(NDV p,struct order_spec *ord)
5074: {
5075: int i,j,adj,len,newnvar,newwpd,newadv,newexporigin,newmpos;
5076: int pos;
5077: Q *w;
5078: Q dvr,t;
5079: NMV m,r;
5080:
5081: len = p->len;
5082: newnvar = nd_nvar-1;
5083: newexporigin = nd_get_exporigin(ord);
5084: if ( nd_module ) newmpos = newexporigin-1;
5085: newwpd = newnvar/nd_epw+(newnvar%nd_epw?1:0)+newexporigin;
5086: for ( m = BDY(p), i = 0; i < len; NMV_ADV(m), i++ )
5087: ndl_dehomogenize(DL(m));
5088: if ( newwpd != nd_wpd ) {
5089: newadv = ROUND_FOR_ALIGN(sizeof(struct oNMV)+(newwpd-1)*sizeof(UINT));
5090: for ( m = r = BDY(p), i = 0; i < len; NMV_ADV(m), NDV_NADV(r), i++ ) {
1.6 noro 5091: CZ(r) = CZ(m);
1.1 noro 5092: if ( nd_module ) pos = MPOS(DL(m));
5093: for ( j = 0; j < newexporigin; j++ ) DL(r)[j] = DL(m)[j];
5094: adj = nd_exporigin-newexporigin;
5095: for ( ; j < newwpd; j++ ) DL(r)[j] = DL(m)[j+adj];
5096: if ( nd_module ) {
5097: DL(r)[newmpos] = pos;
5098: }
5099: }
5100: }
5101: NV(p)--;
5102: }
5103:
5104: void nd_heu_nezgcdnpz(VL vl,P *pl,int m,int full,P *pr)
5105: {
5106: int i;
5107: P *tpl,*tpl1;
5108: NODE l;
5109: P h,gcd,t;
5110:
5111: tpl = (P *)MALLOC(m*sizeof(P));
5112: tpl1 = (P *)MALLOC(m*sizeof(P));
5113: bcopy(pl,tpl,m*sizeof(P));
5114: gcd = (P)ONE;
5115: for ( l = nd_hcf; l; l = NEXT(l) ) {
5116: h = (P)BDY(l);
5117: while ( 1 ) {
5118: for ( i = 0; i < m; i++ )
5119: if ( !divtpz(vl,tpl[i],h,&tpl1[i]) )
5120: break;
5121: if ( i == m ) {
5122: bcopy(tpl1,tpl,m*sizeof(P));
5123: mulp(vl,gcd,h,&t); gcd = t;
5124: } else
5125: break;
5126: }
5127: }
5128: if ( DP_Print > 2 ){fprintf(asir_out,"[%d]",nmonop(gcd)); fflush(asir_out);}
5129: if ( full ) {
5130: heu_nezgcdnpz(vl,tpl,m,&t);
5131: mulp(vl,gcd,t,pr);
5132: } else
5133: *pr = gcd;
5134: }
5135:
5136: void removecont_array(P *p,int n,int full)
5137: {
5138: int all_p,all_q,i;
5139: Z *c;
5140: P *w;
5141: P t,s;
5142:
5143: for ( all_q = 1, i = 0; i < n; i++ )
5144: all_q = all_q && NUM(p[i]);
5145: if ( all_q ) {
5146: removecont_array_q((Z *)p,n);
5147: } else {
5148: c = (Z *)MALLOC(n*sizeof(Z));
5149: w = (P *)MALLOC(n*sizeof(P));
5150: for ( i = 0; i < n; i++ ) {
5151: ptozp(p[i],1,(Q *)&c[i],&w[i]);
5152: }
5153: removecont_array_q(c,n);
5154: nd_heu_nezgcdnpz(nd_vc,w,n,full,&t);
5155: for ( i = 0; i < n; i++ ) {
5156: divsp(nd_vc,w[i],t,&s); mulp(nd_vc,s,(P)c[i],&p[i]);
5157: }
5158: }
5159: }
5160:
5161: /* c is an int array */
5162:
5163: void removecont_array_q(Z *c,int n)
5164: {
5165: struct oVECT v;
5166: Z d0,d1,a,u,u1,gcd;
5167: int i,j;
5168: Z *q,*r;
5169:
5170: q = (Z *)MALLOC(n*sizeof(Z));
5171: r = (Z *)MALLOC(n*sizeof(Z));
5172: v.id = O_VECT; v.len = n; v.body = (pointer *)c;
5173: gcdvz_estimate(&v,&d0);
5174: for ( i = 0; i < n; i++ ) {
5175: divqrz(c[i],d0,&q[i],&r[i]);
5176: }
5177: for ( i = 0; i < n; i++ ) if ( r[i] ) break;
5178: if ( i < n ) {
5179: v.id = O_VECT; v.len = n; v.body = (pointer *)r;
5180: gcdvz(&v,&d1);
5181: gcdz(d0,d1,&gcd);
1.6 noro 5182: /* exact division */
5183: divsz(d0,gcd,&a);
1.1 noro 5184: for ( i = 0; i < n; i++ ) {
5185: mulz(a,q[i],&u);
5186: if ( r[i] ) {
1.6 noro 5187: /* exact division */
5188: divsz(r[i],gcd,&u1);
1.1 noro 5189: addz(u,u1,&q[i]);
5190: } else
5191: q[i] = u;
5192: }
5193: }
5194: for ( i = 0; i < n; i++ ) c[i] = q[i];
5195: }
5196:
1.4 noro 5197: void gcdv_mpz_estimate(mpz_t d0,mpz_t *c,int n);
5198:
5199: void mpz_removecont_array(mpz_t *c,int n)
5200: {
5201: mpz_t d0,a,u,u1,gcd;
5202: int i,j;
1.13 noro 5203: static mpz_t *q,*r;
5204: static int c_len = 0;
1.4 noro 5205:
5206: for ( i = 0; i < n; i++ )
5207: if ( mpz_sgn(c[i]) ) break;
5208: if ( i == n ) return;
5209: gcdv_mpz_estimate(d0,c,n);
1.13 noro 5210: if ( n > c_len ) {
5211: q = (mpz_t *)MALLOC(n*sizeof(mpz_t));
5212: r = (mpz_t *)MALLOC(n*sizeof(mpz_t));
5213: c_len = n;
5214: }
1.4 noro 5215: for ( i = 0; i < n; i++ ) {
5216: mpz_init(q[i]); mpz_init(r[i]);
5217: mpz_fdiv_qr(q[i],r[i],c[i],d0);
5218: }
5219: for ( i = 0; i < n; i++ )
5220: if ( mpz_sgn(r[i]) ) break;
5221: mpz_init(gcd); mpz_init(a); mpz_init(u); mpz_init(u1);
5222: if ( i < n ) {
5223: mpz_gcd(gcd,d0,r[i]);
5224: for ( j = i+1; j < n; j++ ) mpz_gcd(gcd,gcd,r[j]);
5225: mpz_div(a,d0,gcd);
5226: for ( i = 0; i < n; i++ ) {
5227: mpz_mul(u,a,q[i]);
5228: if ( mpz_sgn(r[i]) ) {
5229: mpz_div(u1,r[i],gcd);
5230: mpz_add(q[i],u,u1);
5231: } else
5232: mpz_set(q[i],u);
5233: }
5234: }
5235: for ( i = 0; i < n; i++ )
5236: mpz_set(c[i],q[i]);
5237: }
5238:
1.1 noro 5239: void nd_mul_c(int mod,ND p,int mul)
5240: {
5241: NM m;
5242: int c,c1;
5243:
5244: if ( !p ) return;
5245: if ( mul == 1 ) return;
5246: if ( mod == -1 )
5247: for ( m = BDY(p); m; m = NEXT(m) )
5248: CM(m) = _mulsf(CM(m),mul);
5249: else
5250: for ( m = BDY(p); m; m = NEXT(m) ) {
5251: c1 = CM(m); DMAR(c1,mul,0,mod,c); CM(m) = c;
5252: }
5253: }
5254:
5255: void nd_mul_c_lf(ND p,Z mul)
5256: {
5257: NM m;
5258: Z c;
5259:
5260: if ( !p ) return;
5261: if ( UNIZ(mul) ) return;
5262: for ( m = BDY(p); m; m = NEXT(m) ) {
5263: mullf(CZ(m),mul,&c); CZ(m) = c;
5264: }
5265: }
5266:
5267: void nd_mul_c_q(ND p,P mul)
5268: {
5269: NM m;
5270: P c;
5271:
5272: if ( !p ) return;
5273: if ( UNIQ(mul) ) return;
5274: for ( m = BDY(p); m; m = NEXT(m) ) {
5275: mulp(nd_vc,CP(m),mul,&c); CP(m) = c;
5276: }
5277: }
5278:
5279: void nd_mul_c_p(VL vl,ND p,P mul)
5280: {
5281: NM m;
5282: P c;
5283:
5284: if ( !p ) return;
5285: for ( m = BDY(p); m; m = NEXT(m) ) {
5286: mulp(vl,CP(m),mul,&c); CP(m) = c;
5287: }
5288: }
5289:
5290: void nd_free(ND p)
5291: {
5292: NM t,s;
5293:
5294: if ( !p ) return;
5295: t = BDY(p);
5296: while ( t ) {
5297: s = NEXT(t);
5298: FREENM(t);
5299: t = s;
5300: }
5301: FREEND(p);
5302: }
5303:
5304: void ndv_free(NDV p)
5305: {
5306: GCFREE(BDY(p));
5307: }
5308:
5309: void nd_append_red(UINT *d,int i)
5310: {
5311: RHist m,m0;
5312: int h;
5313:
5314: NEWRHist(m);
5315: h = ndl_hash_value(d);
5316: m->index = i;
5317: ndl_copy(d,DL(m));
5318: NEXT(m) = nd_red[h];
5319: nd_red[h] = m;
5320: }
5321:
5322: UINT *ndv_compute_bound(NDV p)
5323: {
5324: UINT *d1,*d2,*t;
5325: UINT u;
5326: int i,j,k,l,len,ind;
5327: NMV m;
5328:
5329: if ( !p )
5330: return 0;
5331: d1 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
5332: d2 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
5333: len = LEN(p);
5334: m = BDY(p); ndl_copy(DL(m),d1); NMV_ADV(m);
5335: for ( i = 1; i < len; i++, NMV_ADV(m) ) {
5336: ndl_max(DL(m),d1,d2);
5337: t = d1; d1 = d2; d2 = t;
5338: }
5339: l = nd_nvar+31;
5340: t = (UINT *)MALLOC_ATOMIC(l*sizeof(UINT));
5341: for ( i = nd_exporigin, ind = 0; i < nd_wpd; i++ ) {
5342: u = d1[i];
5343: k = (nd_epw-1)*nd_bpe;
5344: for ( j = 0; j < nd_epw; j++, k -= nd_bpe, ind++ )
5345: t[ind] = (u>>k)&nd_mask0;
5346: }
5347: for ( ; ind < l; ind++ ) t[ind] = 0;
5348: return t;
5349: }
5350:
5351: UINT *nd_compute_bound(ND p)
5352: {
5353: UINT *d1,*d2,*t;
5354: UINT u;
5355: int i,j,k,l,len,ind;
5356: NM m;
5357:
5358: if ( !p )
5359: return 0;
5360: d1 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
5361: d2 = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
5362: len = LEN(p);
5363: m = BDY(p); ndl_copy(DL(m),d1); m = NEXT(m);
5364: for ( m = NEXT(m); m; m = NEXT(m) ) {
5365: ndl_lcm(DL(m),d1,d2);
5366: t = d1; d1 = d2; d2 = t;
5367: }
5368: l = nd_nvar+31;
5369: t = (UINT *)MALLOC_ATOMIC(l*sizeof(UINT));
5370: for ( i = nd_exporigin, ind = 0; i < nd_wpd; i++ ) {
5371: u = d1[i];
5372: k = (nd_epw-1)*nd_bpe;
5373: for ( j = 0; j < nd_epw; j++, k -= nd_bpe, ind++ )
5374: t[ind] = (u>>k)&nd_mask0;
5375: }
5376: for ( ; ind < l; ind++ ) t[ind] = 0;
5377: return t;
5378: }
5379:
5380: /* if nd_module == 1 then d[nd_exporigin-1] indicates the position */
5381: /* of a term. In this case we need additional 1 word. */
5382:
5383: int nd_get_exporigin(struct order_spec *ord)
5384: {
5385: switch ( ord->id ) {
1.21 noro 5386: case 0: case 2: case 256: case 258: case 300:
1.1 noro 5387: return 1+nd_module;
5388: case 1: case 257:
5389: /* block order */
5390: /* poly ring d[0]:weight d[1]:w0,...,d[nd_exporigin-1]:w(n-1) */
5391: /* module d[0]:weight d[1]:w0,...,d[nd_exporigin-2]:w(n-1) */
5392: return ord->ord.block.length+1+nd_module;
5393: case 3: case 259:
5394: #if 0
5395: error("nd_get_exporigin : composite order is not supported yet.");
5396: #else
5397: return 1+nd_module;
5398: #endif
5399: default:
5400: error("nd_get_exporigin : ivalid argument.");
5401: return 0;
5402: }
5403: }
5404:
5405: void nd_setup_parameters(int nvar,int max) {
5406: int i,j,n,elen,ord_o,ord_l,l,s,wpd;
5407: struct order_pair *op;
5408:
5409: nd_nvar = nvar;
5410: if ( max ) {
5411: /* XXX */
5412: if ( do_weyl ) nd_bpe = 32;
5413: else if ( max < 2 ) nd_bpe = 1;
5414: else if ( max < 4 ) nd_bpe = 2;
5415: else if ( max < 8 ) nd_bpe = 3;
5416: else if ( max < 16 ) nd_bpe = 4;
5417: else if ( max < 32 ) nd_bpe = 5;
5418: else if ( max < 64 ) nd_bpe = 6;
5419: else if ( max < 256 ) nd_bpe = 8;
5420: else if ( max < 1024 ) nd_bpe = 10;
5421: else if ( max < 65536 ) nd_bpe = 16;
5422: else nd_bpe = 32;
5423: }
5424: if ( !do_weyl && weight_check && (current_dl_weight_vector || nd_matrix) ) {
5425: UINT t;
5426: int st;
5427: int *v;
5428: /* t = max(weights) */
5429: t = 0;
5430: if ( current_dl_weight_vector )
5431: for ( i = 0, t = 0; i < nd_nvar; i++ ) {
5432: if ( (st=current_dl_weight_vector[i]) < 0 ) st = -st;
5433: if ( t < st ) t = st;
5434: }
5435: if ( nd_matrix )
5436: for ( i = 0; i < nd_matrix_len; i++ )
5437: for ( j = 0, v = nd_matrix[i]; j < nd_nvar; j++ ) {
5438: if ( (st=v[j]) < 0 ) st = -st;
5439: if ( t < st ) t = st;
5440: }
5441: /* i = bitsize of t */
5442: for ( i = 0; t; t >>=1, i++ );
5443: /* i += bitsize of nd_nvar */
5444: for ( t = nd_nvar; t; t >>=1, i++);
5445: /* nd_bpe+i = bitsize of max(weights)*max(exp)*nd_nvar */
5446: if ( (nd_bpe+i) >= 31 )
5447: error("nd_setup_parameters : too large weight");
5448: }
5449: nd_epw = (sizeof(UINT)*8)/nd_bpe;
5450: elen = nd_nvar/nd_epw+(nd_nvar%nd_epw?1:0);
5451: nd_exporigin = nd_get_exporigin(nd_ord);
5452: wpd = nd_exporigin+elen;
5453: if ( nd_module )
5454: nd_mpos = nd_exporigin-1;
5455: else
5456: nd_mpos = -1;
5457: if ( wpd != nd_wpd ) {
5458: nd_free_private_storage();
5459: nd_wpd = wpd;
5460: }
5461: if ( nd_bpe < 32 ) {
5462: nd_mask0 = (1<<nd_bpe)-1;
5463: } else {
5464: nd_mask0 = 0xffffffff;
5465: }
5466: bzero(nd_mask,sizeof(nd_mask));
5467: nd_mask1 = 0;
5468: for ( i = 0; i < nd_epw; i++ ) {
5469: nd_mask[nd_epw-i-1] = (nd_mask0<<(i*nd_bpe));
5470: nd_mask1 |= (1<<(nd_bpe-1))<<(i*nd_bpe);
5471: }
5472: nmv_adv = ROUND_FOR_ALIGN(sizeof(struct oNMV)+(nd_wpd-1)*sizeof(UINT));
5473: nd_epos = nd_create_epos(nd_ord);
5474: nd_blockmask = nd_create_blockmask(nd_ord);
5475: nd_work_vector = (int *)REALLOC(nd_work_vector,nd_nvar*sizeof(int));
5476: }
5477:
5478: ND_pairs nd_reconstruct(int trace,ND_pairs d)
5479: {
5480: int i,obpe,oadv,h;
5481: static NM prev_nm_free_list;
5482: static ND_pairs prev_ndp_free_list;
5483: RHist mr0,mr;
5484: RHist r;
5485: RHist *old_red;
5486: ND_pairs s0,s,t;
5487: EPOS oepos;
5488:
5489: obpe = nd_bpe;
5490: oadv = nmv_adv;
5491: oepos = nd_epos;
5492: if ( obpe < 2 ) nd_bpe = 2;
5493: else if ( obpe < 3 ) nd_bpe = 3;
5494: else if ( obpe < 4 ) nd_bpe = 4;
5495: else if ( obpe < 5 ) nd_bpe = 5;
5496: else if ( obpe < 6 ) nd_bpe = 6;
5497: else if ( obpe < 8 ) nd_bpe = 8;
5498: else if ( obpe < 10 ) nd_bpe = 10;
5499: else if ( obpe < 16 ) nd_bpe = 16;
5500: else if ( obpe < 32 ) nd_bpe = 32;
5501: else error("nd_reconstruct : exponent too large");
5502:
5503: nd_setup_parameters(nd_nvar,0);
5504: prev_nm_free_list = _nm_free_list;
5505: prev_ndp_free_list = _ndp_free_list;
5506: _nm_free_list = 0;
5507: _ndp_free_list = 0;
5508: for ( i = nd_psn-1; i >= 0; i-- ) {
5509: ndv_realloc(nd_ps[i],obpe,oadv,oepos);
5510: ndv_realloc(nd_ps_sym[i],obpe,oadv,oepos);
5511: }
5512: if ( trace )
5513: for ( i = nd_psn-1; i >= 0; i-- ) {
5514: ndv_realloc(nd_ps_trace[i],obpe,oadv,oepos);
5515: ndv_realloc(nd_ps_trace_sym[i],obpe,oadv,oepos);
5516: }
5517: s0 = 0;
5518: for ( t = d; t; t = NEXT(t) ) {
5519: NEXTND_pairs(s0,s);
5520: s->i1 = t->i1;
5521: s->i2 = t->i2;
1.24 noro 5522: s->sig = t->sig;
1.1 noro 5523: SG(s) = SG(t);
5524: ndl_reconstruct(LCM(t),LCM(s),obpe,oepos);
5525: }
5526:
5527: old_red = (RHist *)MALLOC(REDTAB_LEN*sizeof(RHist));
5528: for ( i = 0; i < REDTAB_LEN; i++ ) {
5529: old_red[i] = nd_red[i];
5530: nd_red[i] = 0;
5531: }
5532: for ( i = 0; i < REDTAB_LEN; i++ )
5533: for ( r = old_red[i]; r; r = NEXT(r) ) {
5534: NEWRHist(mr);
5535: mr->index = r->index;
5536: SG(mr) = SG(r);
5537: ndl_reconstruct(DL(r),DL(mr),obpe,oepos);
5538: h = ndl_hash_value(DL(mr));
5539: NEXT(mr) = nd_red[h];
5540: nd_red[h] = mr;
1.24 noro 5541: mr->sig = r->sig;
1.1 noro 5542: }
5543: for ( i = 0; i < REDTAB_LEN; i++ ) old_red[i] = 0;
5544: old_red = 0;
5545: for ( i = 0; i < nd_psn; i++ ) {
5546: NEWRHist(r); SG(r) = SG(nd_psh[i]);
5547: ndl_reconstruct(DL(nd_psh[i]),DL(r),obpe,oepos);
1.24 noro 5548: r->sig = nd_psh[i]->sig;
1.1 noro 5549: nd_psh[i] = r;
5550: }
5551: if ( s0 ) NEXT(s) = 0;
5552: prev_nm_free_list = 0;
5553: prev_ndp_free_list = 0;
5554: #if 0
5555: GC_gcollect();
5556: #endif
5557: return s0;
5558: }
5559:
5560: void ndl_reconstruct(UINT *d,UINT *r,int obpe,EPOS oepos)
5561: {
5562: int n,i,ei,oepw,omask0,j,s,ord_l,l;
5563: struct order_pair *op;
5564:
5565: n = nd_nvar;
5566: oepw = (sizeof(UINT)*8)/obpe;
5567: omask0 = (1<<obpe)-1;
5568: TD(r) = TD(d);
5569: for ( i = nd_exporigin; i < nd_wpd; i++ ) r[i] = 0;
5570: if ( nd_blockmask ) {
5571: l = nd_blockmask->n;
5572: op = nd_blockmask->order_pair;
5573: for ( i = 1; i < nd_exporigin; i++ )
5574: r[i] = d[i];
5575: for ( j = 0, s = 0; j < l; j++ ) {
5576: ord_l = op[j].length;
5577: for ( i = 0; i < ord_l; i++, s++ ) {
5578: ei = GET_EXP_OLD(d,s);
5579: PUT_EXP(r,s,ei);
5580: }
5581: }
5582: } else {
5583: for ( i = 0; i < n; i++ ) {
5584: ei = GET_EXP_OLD(d,i);
5585: PUT_EXP(r,i,ei);
5586: }
5587: }
5588: if ( nd_module ) MPOS(r) = MPOS(d);
5589: }
5590:
5591: ND nd_copy(ND p)
5592: {
5593: NM m,mr,mr0;
5594: int c,n;
5595: ND r;
5596:
5597: if ( !p )
5598: return 0;
5599: else {
5600: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
5601: NEXTNM(mr0,mr);
5602: CM(mr) = CM(m);
5603: ndl_copy(DL(m),DL(mr));
5604: }
5605: NEXT(mr) = 0;
5606: MKND(NV(p),mr0,LEN(p),r);
5607: SG(r) = SG(p);
5608: return r;
5609: }
5610: }
5611:
5612: int nd_sp(int mod,int trace,ND_pairs p,ND *rp)
5613: {
5614: NM m1,m2;
5615: NDV p1,p2;
5616: ND t1,t2;
5617: UINT *lcm;
5618: P gp,tp;
5619: Z g,t;
5620: Z iq;
5621: int td;
5622: LIST hist;
5623: NODE node;
5624: DP d;
5625:
5626: if ( !mod && nd_demand ) {
5627: p1 = ndv_load(p->i1); p2 = ndv_load(p->i2);
5628: } else {
5629: if ( trace ) {
5630: p1 = nd_ps_trace[p->i1]; p2 = nd_ps_trace[p->i2];
5631: } else {
5632: p1 = nd_ps[p->i1]; p2 = nd_ps[p->i2];
5633: }
5634: }
5635: lcm = LCM(p);
5636: NEWNM(m1); ndl_sub(lcm,HDL(p1),DL(m1));
5637: if ( ndl_check_bound2(p->i1,DL(m1)) ) {
5638: FREENM(m1); return 0;
5639: }
5640: NEWNM(m2); ndl_sub(lcm,HDL(p2),DL(m2));
5641: if ( ndl_check_bound2(p->i2,DL(m2)) ) {
5642: FREENM(m1); FREENM(m2); return 0;
5643: }
5644:
5645: if ( mod == -1 ) {
5646: CM(m1) = HCM(p2); CM(m2) = _chsgnsf(HCM(p1));
5647: } else if ( mod > 0 ) {
5648: CM(m1) = HCM(p2); CM(m2) = mod-HCM(p1);
5649: } else if ( mod == -2 ) {
5650: CZ(m1) = HCZ(p2); chsgnlf(HCZ(p1),&CZ(m2));
5651: } else if ( nd_vc ) {
5652: ezgcdpz(nd_vc,HCP(p1),HCP(p2),&gp);
5653: divsp(nd_vc,HCP(p2),gp,&CP(m1));
5654: divsp(nd_vc,HCP(p1),gp,&tp); chsgnp(tp,&CP(m2));
5655: } else {
1.6 noro 5656: igcd_cofactor(HCZ(p1),HCZ(p2),&g,&t,&CZ(m1)); chsgnz(t,&CZ(m2));
1.1 noro 5657: }
5658: t1 = ndv_mul_nm(mod,m1,p1); t2 = ndv_mul_nm(mod,m2,p2);
5659: *rp = nd_add(mod,t1,t2);
5660: if ( nd_gentrace ) {
5661: /* nd_tracelist is initialized */
1.6 noro 5662: STOZ(p->i1,iq); nmtodp(mod,m1,&d); node = mknode(4,ONE,iq,d,ONE);
1.1 noro 5663: MKLIST(hist,node); MKNODE(nd_tracelist,hist,0);
1.6 noro 5664: STOZ(p->i2,iq); nmtodp(mod,m2,&d); node = mknode(4,ONE,iq,d,ONE);
1.1 noro 5665: MKLIST(hist,node); MKNODE(node,hist,nd_tracelist);
5666: nd_tracelist = node;
5667: }
1.24 noro 5668: if ( *rp )
5669: (*rp)->sig = p->sig;
1.1 noro 5670: FREENM(m1); FREENM(m2);
5671: return 1;
5672: }
5673:
5674: void ndv_mul_c(int mod,NDV p,int mul)
5675: {
5676: NMV m;
5677: int c,c1,len,i;
5678:
5679: if ( !p ) return;
5680: len = LEN(p);
5681: if ( mod == -1 )
5682: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) )
5683: CM(m) = _mulsf(CM(m),mul);
5684: else
5685: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
5686: c1 = CM(m); DMAR(c1,mul,0,mod,c); CM(m) = c;
5687: }
5688: }
5689:
5690: void ndv_mul_c_lf(NDV p,Z mul)
5691: {
5692: NMV m;
5693: Z c;
5694: int len,i;
5695:
5696: if ( !p ) return;
5697: len = LEN(p);
5698: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
5699: mullf(CZ(m),mul,&c); CZ(m) = c;
5700: }
5701: }
5702:
5703: /* for nd_det */
5704: void ndv_mul_c_q(NDV p,Z mul)
5705: {
5706: NMV m;
5707: Z c;
5708: int len,i;
5709:
5710: if ( !p ) return;
5711: len = LEN(p);
5712: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
1.6 noro 5713: mulz(CZ(m),mul,&c); CZ(m) = c;
1.1 noro 5714: }
5715: }
5716:
5717: ND weyl_ndv_mul_nm(int mod,NM m0,NDV p) {
5718: int n2,i,j,l,n,tlen;
5719: UINT *d0;
5720: NM *tab,*psum;
5721: ND s,r;
5722: NM t;
5723: NMV m1;
5724:
5725: if ( !p ) return 0;
5726: n = NV(p); n2 = n>>1;
5727: d0 = DL(m0);
5728: l = LEN(p);
5729: for ( i = 0, tlen = 1; i < n2; i++ ) tlen *= (GET_EXP(d0,n2+i)+1);
5730: tab = (NM *)MALLOC(tlen*sizeof(NM));
5731: psum = (NM *)MALLOC(tlen*sizeof(NM));
5732: for ( i = 0; i < tlen; i++ ) psum[i] = 0;
5733: m1 = (NMV)(((char *)BDY(p))+nmv_adv*(l-1));
5734: for ( i = l-1; i >= 0; i--, NMV_PREV(m1) ) {
5735: /* m0(NM) * m1(NMV) => tab(NM) */
5736: weyl_mul_nm_nmv(n,mod,m0,m1,tab,tlen);
5737: for ( j = 0; j < tlen; j++ ) {
5738: if ( tab[j] ) {
5739: NEXT(tab[j]) = psum[j]; psum[j] = tab[j];
5740: }
5741: }
5742: }
5743: for ( i = tlen-1, r = 0; i >= 0; i-- )
5744: if ( psum[i] ) {
5745: for ( j = 0, t = psum[i]; t; t = NEXT(t), j++ );
5746: MKND(n,psum[i],j,s);
5747: r = nd_add(mod,r,s);
5748: }
5749: if ( r ) SG(r) = SG(p)+TD(d0);
5750: return r;
5751: }
5752:
5753: /* product of monomials */
5754: /* XXX block order is not handled correctly */
5755:
5756: void weyl_mul_nm_nmv(int n,int mod,NM m0,NMV m1,NM *tab,int tlen)
5757: {
5758: int i,n2,j,s,curlen,homo,h,a,b,k,l,u,min;
5759: UINT *d0,*d1,*d,*dt,*ctab;
5760: Z *ctab_q;
5761: Z q,q1;
5762: UINT c0,c1,c;
5763: NM *p;
5764: NM m,t;
5765: int mpos;
5766:
5767: for ( i = 0; i < tlen; i++ ) tab[i] = 0;
5768: if ( !m0 || !m1 ) return;
5769: d0 = DL(m0); d1 = DL(m1); n2 = n>>1;
5770: if ( nd_module )
5771: if ( MPOS(d0) ) error("weyl_mul_nm_nmv : invalid operation");
5772:
5773: NEWNM(m); d = DL(m);
5774: if ( mod ) {
5775: c0 = CM(m0); c1 = CM(m1); DMAR(c0,c1,0,mod,c); CM(m) = c;
5776: } else if ( nd_vc )
5777: mulp(nd_vc,CP(m0),CP(m1),&CP(m));
5778: else
1.6 noro 5779: mulz(CZ(m0),CZ(m1),&CZ(m));
1.1 noro 5780: for ( i = 0; i < nd_wpd; i++ ) d[i] = 0;
5781: homo = n&1 ? 1 : 0;
5782: if ( homo ) {
5783: /* offset of h-degree */
5784: h = GET_EXP(d0,n-1)+GET_EXP(d1,n-1);
5785: PUT_EXP(DL(m),n-1,h);
5786: TD(DL(m)) = h;
5787: if ( nd_blockmask ) ndl_weight_mask(DL(m));
5788: }
5789: tab[0] = m;
5790: NEWNM(m); d = DL(m);
5791: for ( i = 0, curlen = 1; i < n2; i++ ) {
5792: a = GET_EXP(d0,i); b = GET_EXP(d1,n2+i);
5793: k = GET_EXP(d0,n2+i); l = GET_EXP(d1,i);
5794: /* xi^a*(Di^k*xi^l)*Di^b */
5795: a += l; b += k;
5796: s = MUL_WEIGHT(a,i)+MUL_WEIGHT(b,n2+i);
5797: if ( !k || !l ) {
5798: for ( j = 0; j < curlen; j++ )
5799: if ( (t = tab[j]) != 0 ) {
5800: dt = DL(t);
5801: PUT_EXP(dt,i,a); PUT_EXP(dt,n2+i,b); TD(dt) += s;
5802: if ( nd_blockmask ) ndl_weight_mask(dt);
5803: }
5804: curlen *= k+1;
5805: continue;
5806: }
5807: min = MIN(k,l);
5808: if ( mod ) {
5809: ctab = (UINT *)MALLOC((min+1)*sizeof(UINT));
5810: mkwcm(k,l,mod,(int *)ctab);
5811: } else {
5812: ctab_q = (Z *)MALLOC((min+1)*sizeof(Z));
5813: mkwc(k,l,ctab_q);
5814: }
5815: for ( j = min; j >= 0; j-- ) {
5816: for ( u = 0; u < nd_wpd; u++ ) d[u] = 0;
5817: PUT_EXP(d,i,a-j); PUT_EXP(d,n2+i,b-j);
5818: h = MUL_WEIGHT(a-j,i)+MUL_WEIGHT(b-j,n2+i);
5819: if ( homo ) {
5820: TD(d) = s;
5821: PUT_EXP(d,n-1,s-h);
5822: } else TD(d) = h;
5823: if ( nd_blockmask ) ndl_weight_mask(d);
5824: if ( mod ) c = ctab[j];
5825: else q = ctab_q[j];
5826: p = tab+curlen*j;
5827: if ( j == 0 ) {
5828: for ( u = 0; u < curlen; u++, p++ ) {
5829: if ( tab[u] ) {
5830: ndl_addto(DL(tab[u]),d);
5831: if ( mod ) {
5832: c0 = CM(tab[u]); DMAR(c0,c,0,mod,c1); CM(tab[u]) = c1;
5833: } else if ( nd_vc )
5834: mulp(nd_vc,CP(tab[u]),(P)q,&CP(tab[u]));
5835: else {
1.6 noro 5836: mulz(CZ(tab[u]),q,&q1); CZ(tab[u]) = q1;
1.1 noro 5837: }
5838: }
5839: }
5840: } else {
5841: for ( u = 0; u < curlen; u++, p++ ) {
5842: if ( tab[u] ) {
5843: NEWNM(t);
5844: ndl_add(DL(tab[u]),d,DL(t));
5845: if ( mod ) {
5846: c0 = CM(tab[u]); DMAR(c0,c,0,mod,c1); CM(t) = c1;
5847: } else if ( nd_vc )
5848: mulp(nd_vc,CP(tab[u]),(P)q,&CP(t));
5849: else
1.6 noro 5850: mulz(CZ(tab[u]),q,&CZ(t));
1.1 noro 5851: *p = t;
5852: }
5853: }
5854: }
5855: }
5856: curlen *= k+1;
5857: }
5858: FREENM(m);
5859: if ( nd_module ) {
5860: mpos = MPOS(d1);
5861: for ( i = 0; i < tlen; i++ )
5862: if ( tab[i] ) {
5863: d = DL(tab[i]);
5864: MPOS(d) = mpos;
5865: TD(d) = ndl_weight(d);
5866: }
5867: }
5868: }
5869:
5870: ND ndv_mul_nm_symbolic(NM m0,NDV p)
5871: {
5872: NM mr,mr0;
5873: NMV m;
5874: UINT *d,*dt,*dm;
5875: int c,n,td,i,c1,c2,len;
5876: Q q;
5877: ND r;
5878:
5879: if ( !p ) return 0;
5880: else {
5881: n = NV(p); m = BDY(p);
5882: d = DL(m0);
5883: len = LEN(p);
5884: mr0 = 0;
5885: td = TD(d);
5886: c = CM(m0);
5887: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5888: NEXTNM(mr0,mr);
5889: CM(mr) = 1;
5890: ndl_add(DL(m),d,DL(mr));
5891: }
5892: NEXT(mr) = 0;
5893: MKND(NV(p),mr0,len,r);
5894: SG(r) = SG(p) + TD(d);
5895: return r;
5896: }
5897: }
5898:
5899: ND ndv_mul_nm(int mod,NM m0,NDV p)
5900: {
5901: NM mr,mr0;
5902: NMV m;
5903: UINT *d,*dt,*dm;
5904: int c,n,td,i,c1,c2,len;
5905: P q;
5906: ND r;
5907:
5908: if ( !p ) return 0;
5909: else if ( do_weyl ) {
5910: if ( mod < 0 ) {
5911: error("ndv_mul_nm : not implemented (weyl)");
5912: return 0;
5913: } else
5914: return weyl_ndv_mul_nm(mod,m0,p);
5915: } else {
5916: n = NV(p); m = BDY(p);
5917: d = DL(m0);
5918: len = LEN(p);
5919: mr0 = 0;
5920: td = TD(d);
5921: if ( mod == -1 ) {
5922: c = CM(m0);
5923: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5924: NEXTNM(mr0,mr);
5925: CM(mr) = _mulsf(CM(m),c);
5926: ndl_add(DL(m),d,DL(mr));
5927: }
5928: } else if ( mod == -2 ) {
5929: Z cl;
5930: cl = CZ(m0);
5931: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5932: NEXTNM(mr0,mr);
5933: mullf(CZ(m),cl,&CZ(mr));
5934: ndl_add(DL(m),d,DL(mr));
5935: }
5936: } else if ( mod ) {
5937: c = CM(m0);
5938: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5939: NEXTNM(mr0,mr);
5940: c1 = CM(m);
5941: DMAR(c1,c,0,mod,c2);
5942: CM(mr) = c2;
5943: ndl_add(DL(m),d,DL(mr));
5944: }
5945: } else {
5946: q = CP(m0);
5947: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
5948: NEXTNM(mr0,mr);
5949: mulp(nd_vc,CP(m),q,&CP(mr));
5950: ndl_add(DL(m),d,DL(mr));
5951: }
5952: }
5953: NEXT(mr) = 0;
5954: MKND(NV(p),mr0,len,r);
5955: SG(r) = SG(p) + TD(d);
5956: return r;
5957: }
5958: }
5959:
5960: ND nd_quo(int mod,PGeoBucket bucket,NDV d)
5961: {
5962: NM mq0,mq;
5963: NMV tm;
5964: Q q;
5965: int i,nv,sg,c,c1,c2,hindex;
5966: ND p,t,r;
5967:
5968: if ( bucket->m < 0 ) return 0;
5969: else {
5970: nv = NV(d);
5971: mq0 = 0;
5972: tm = (NMV)MALLOC(nmv_adv);
5973: while ( 1 ) {
5974: if ( mod > 0 || mod == -1 )
5975: hindex = head_pbucket(mod,bucket);
5976: else if ( mod == -2 )
5977: hindex = head_pbucket_lf(bucket);
5978: else
5979: hindex = head_pbucket_q(bucket);
5980: if ( hindex < 0 ) break;
5981: p = bucket->body[hindex];
5982: NEXTNM(mq0,mq);
5983: ndl_sub(HDL(p),HDL(d),DL(mq));
5984: ndl_copy(DL(mq),DL(tm));
5985: if ( mod ) {
5986: c1 = invm(HCM(d),mod); c2 = HCM(p);
5987: DMAR(c1,c2,0,mod,c); CM(mq) = c;
5988: CM(tm) = mod-c;
5989: } else {
1.6 noro 5990: divsz(HCZ(p),HCZ(d),&CZ(mq));
5991: chsgnz(CZ(mq),&CZ(tm));
1.1 noro 5992: }
5993: t = ndv_mul_nmv_trunc(mod,tm,d,HDL(d));
5994: bucket->body[hindex] = nd_remove_head(p);
5995: t = nd_remove_head(t);
5996: add_pbucket(mod,bucket,t);
5997: }
5998: if ( !mq0 )
5999: r = 0;
6000: else {
6001: NEXT(mq) = 0;
6002: for ( i = 0, mq = mq0; mq; mq = NEXT(mq), i++ );
6003: MKND(nv,mq0,i,r);
6004: /* XXX */
6005: SG(r) = HTD(r);
6006: }
6007: return r;
6008: }
6009: }
6010:
6011: void ndv_realloc(NDV p,int obpe,int oadv,EPOS oepos)
6012: {
6013: NMV m,mr,mr0,t;
6014: int len,i,k;
6015:
6016: if ( !p ) return;
6017: m = BDY(p); len = LEN(p);
6018: mr0 = nmv_adv>oadv?(NMV)REALLOC(BDY(p),len*nmv_adv):BDY(p);
6019: m = (NMV)((char *)mr0+(len-1)*oadv);
6020: mr = (NMV)((char *)mr0+(len-1)*nmv_adv);
6021: t = (NMV)MALLOC(nmv_adv);
6022: for ( i = 0; i < len; i++, NMV_OPREV(m), NMV_PREV(mr) ) {
1.6 noro 6023: CZ(t) = CZ(m);
1.1 noro 6024: for ( k = 0; k < nd_wpd; k++ ) DL(t)[k] = 0;
6025: ndl_reconstruct(DL(m),DL(t),obpe,oepos);
1.6 noro 6026: CZ(mr) = CZ(t);
1.1 noro 6027: ndl_copy(DL(t),DL(mr));
6028: }
6029: BDY(p) = mr0;
6030: }
6031:
6032: NDV ndv_dup_realloc(NDV p,int obpe,int oadv,EPOS oepos)
6033: {
6034: NMV m,mr,mr0;
6035: int len,i;
6036: NDV r;
6037:
6038: if ( !p ) return 0;
6039: m = BDY(p); len = LEN(p);
6040: mr0 = mr = (NMV)MALLOC(len*nmv_adv);
6041: for ( i = 0; i < len; i++, NMV_OADV(m), NMV_ADV(mr) ) {
6042: ndl_zero(DL(mr));
6043: ndl_reconstruct(DL(m),DL(mr),obpe,oepos);
1.6 noro 6044: CZ(mr) = CZ(m);
1.1 noro 6045: }
6046: MKNDV(NV(p),mr0,len,r);
6047: SG(r) = SG(p);
1.24 noro 6048: r->sig = p->sig;
1.1 noro 6049: return r;
6050: }
6051:
6052: /* duplicate p */
6053:
6054: NDV ndv_dup(int mod,NDV p)
6055: {
6056: NDV d;
6057: NMV t,m,m0;
6058: int i,len;
6059:
6060: if ( !p ) return 0;
6061: len = LEN(p);
6062: m0 = m = (NMV)((mod>0 || mod==-1)?MALLOC_ATOMIC(len*nmv_adv):MALLOC(len*nmv_adv));
6063: for ( t = BDY(p), i = 0; i < len; i++, NMV_ADV(t), NMV_ADV(m) ) {
6064: ndl_copy(DL(t),DL(m));
1.6 noro 6065: CZ(m) = CZ(t);
1.1 noro 6066: }
6067: MKNDV(NV(p),m0,len,d);
6068: SG(d) = SG(p);
6069: return d;
6070: }
6071:
6072: NDV ndv_symbolic(int mod,NDV p)
6073: {
6074: NDV d;
6075: NMV t,m,m0;
6076: int i,len;
6077:
6078: if ( !p ) return 0;
6079: len = LEN(p);
6080: m0 = m = (NMV)((mod>0||mod==-1)?MALLOC_ATOMIC(len*nmv_adv):MALLOC(len*nmv_adv));
6081: for ( t = BDY(p), i = 0; i < len; i++, NMV_ADV(t), NMV_ADV(m) ) {
6082: ndl_copy(DL(t),DL(m));
1.6 noro 6083: CZ(m) = ONE;
1.1 noro 6084: }
6085: MKNDV(NV(p),m0,len,d);
6086: SG(d) = SG(p);
6087: return d;
6088: }
6089:
6090: ND nd_dup(ND p)
6091: {
6092: ND d;
6093: NM t,m,m0;
6094:
6095: if ( !p ) return 0;
6096: for ( m0 = 0, t = BDY(p); t; t = NEXT(t) ) {
6097: NEXTNM(m0,m);
6098: ndl_copy(DL(t),DL(m));
1.6 noro 6099: CZ(m) = CZ(t);
1.1 noro 6100: }
6101: if ( m0 ) NEXT(m) = 0;
6102: MKND(NV(p),m0,LEN(p),d);
6103: SG(d) = SG(p);
6104: return d;
6105: }
6106:
6107: /* XXX if p->len == 0 then it represents 0 */
6108:
6109: void ndv_mod(int mod,NDV p)
6110: {
6111: NMV t,d;
6112: int r,s,u;
6113: int i,len,dlen;
6114: P cp;
6115: Z c;
6116: Obj gfs;
6117:
6118: if ( !p ) return;
6119: len = LEN(p);
6120: dlen = 0;
6121: if ( mod == -1 )
6122: for ( t = d = BDY(p), i = 0; i < len; i++, NMV_ADV(t) ) {
6123: simp_ff((Obj)CP(t),&gfs);
6124: if ( gfs ) {
6125: r = FTOIF(CONT((GFS)gfs));
6126: CM(d) = r;
6127: ndl_copy(DL(t),DL(d));
6128: NMV_ADV(d);
6129: dlen++;
6130: }
6131: }
6132: else if ( mod == -2 )
6133: for ( t = d = BDY(p), i = 0; i < len; i++, NMV_ADV(t) ) {
6134: simp_ff((Obj)CP(t),&gfs);
6135: if ( gfs ) {
6136: lmtolf((LM)gfs,&CZ(d));
6137: ndl_copy(DL(t),DL(d));
6138: NMV_ADV(d);
6139: dlen++;
6140: }
6141: }
6142: else
6143: for ( t = d = BDY(p), i = 0; i < len; i++, NMV_ADV(t) ) {
6144: if ( nd_vc ) {
6145: nd_subst_vector(nd_vc,CP(t),nd_subst,&cp);
6146: c = (Z)cp;
6147: } else
1.6 noro 6148: c = CZ(t);
1.1 noro 6149: r = remqi((Q)c,mod);
6150: if ( r ) {
6151: CM(d) = r;
6152: ndl_copy(DL(t),DL(d));
6153: NMV_ADV(d);
6154: dlen++;
6155: }
6156: }
6157: LEN(p) = dlen;
6158: }
6159:
6160: NDV ptondv(VL vl,VL dvl,P p)
6161: {
6162: ND nd;
6163:
6164: nd = ptond(vl,dvl,p);
6165: return ndtondv(0,nd);
6166: }
6167:
6168: void pltozpl(LIST l,Q *cont,LIST *pp)
6169: {
1.16 noro 6170: NODE nd,nd1;
6171: int n;
6172: P *pl;
6173: Q *cl;
6174: int i;
6175: P dmy;
6176: Z dvr,inv;
6177: LIST r;
6178:
6179: nd = BDY(l); n = length(nd);
6180: pl = (P *)MALLOC(n*sizeof(P));
6181: cl = (Q *)MALLOC(n*sizeof(Q));
6182: for ( i = 0; i < n; i++, nd = NEXT(nd) ) {
6183: ptozp((P)BDY(nd),1,&cl[i],&dmy);
6184: }
6185: qltozl(cl,n,&dvr);
6186: divz(ONE,dvr,&inv);
6187: nd = BDY(l);
6188: for ( i = 0; i < n; i++, nd = NEXT(nd) )
6189: divsp(CO,(P)BDY(nd),(P)dvr,&pl[i]);
6190: nd = 0;
6191: for ( i = n-1; i >= 0; i-- ) {
6192: MKNODE(nd1,pl[i],nd); nd = nd1;
6193: }
6194: MKLIST(r,nd);
6195: *pp = r;
1.1 noro 6196: }
6197:
6198: /* (a1,a2,...,an) -> a1*e(1)+...+an*e(n) */
6199:
6200: NDV pltondv(VL vl,VL dvl,LIST p)
6201: {
6202: int i;
6203: NODE t;
6204: ND r,ri;
6205: NM m;
6206:
6207: if ( !nd_module ) error("pltond : module order must be set");
6208: r = 0;
6209: for ( i = 1, t = BDY(p); t; t = NEXT(t), i++ ) {
6210: ri = ptond(vl,dvl,(P)BDY(t));
6211: if ( ri )
6212: for ( m = BDY(ri); m; m = NEXT(m) ) {
6213: MPOS(DL(m)) = i;
6214: TD(DL(m)) = ndl_weight(DL(m));
6215: if ( nd_blockmask ) ndl_weight_mask(DL(m));
6216: }
6217: r = nd_add(0,r,ri);
6218: }
6219: return ndtondv(0,r);
6220: }
6221:
6222: ND ptond(VL vl,VL dvl,P p)
6223: {
6224: int n,i,j,k,e;
6225: VL tvl;
6226: V v;
6227: DCP dc;
6228: DCP *w;
6229: ND r,s,t,u;
6230: P x;
6231: int c;
6232: UINT *d;
6233: NM m,m0;
6234:
6235: if ( !p )
6236: return 0;
6237: else if ( NUM(p) ) {
6238: NEWNM(m);
6239: ndl_zero(DL(m));
6240: if ( !INT((Q)p) )
6241: error("ptond : input must be integer-coefficient");
1.6 noro 6242: CZ(m) = (Z)p;
1.1 noro 6243: NEXT(m) = 0;
6244: MKND(nd_nvar,m,1,r);
6245: SG(r) = 0;
6246: return r;
6247: } else {
6248: for ( dc = DC(p), k = 0; dc; dc = NEXT(dc), k++ );
6249: w = (DCP *)MALLOC(k*sizeof(DCP));
6250: for ( dc = DC(p), j = 0; j < k; dc = NEXT(dc), j++ ) w[j] = dc;
6251: for ( i = 0, tvl = dvl, v = VR(p);
6252: tvl && tvl->v != v; tvl = NEXT(tvl), i++ );
6253: if ( !tvl ) {
6254: for ( j = k-1, s = 0, MKV(v,x); j >= 0; j-- ) {
6255: t = ptond(vl,dvl,COEF(w[j]));
6256: pwrp(vl,x,DEG(w[j]),&p);
6257: nd_mul_c_p(CO,t,p); s = nd_add(0,s,t);
6258: }
6259: return s;
6260: } else {
6261: NEWNM(m0); d = DL(m0);
6262: for ( j = k-1, s = 0; j >= 0; j-- ) {
1.6 noro 6263: ndl_zero(d); e = ZTOS(DEG(w[j])); PUT_EXP(d,i,e);
1.1 noro 6264: TD(d) = MUL_WEIGHT(e,i);
6265: if ( nd_blockmask) ndl_weight_mask(d);
6266: if ( nd_module ) MPOS(d) = 0;
6267: t = ptond(vl,dvl,COEF(w[j]));
6268: for ( m = BDY(t); m; m = NEXT(m) )
6269: ndl_addto(DL(m),d);
6270: SG(t) += TD(d);
6271: s = nd_add(0,s,t);
6272: }
6273: FREENM(m0);
6274: return s;
6275: }
6276: }
6277: }
6278:
6279: P ndvtop(int mod,VL vl,VL dvl,NDV p)
6280: {
6281: VL tvl;
6282: int len,n,j,i,e;
6283: NMV m;
6284: Z q;
6285: P c;
6286: UINT *d;
6287: P s,r,u,t,w;
6288: GFS gfs;
6289:
6290: if ( !p ) return 0;
6291: else {
6292: len = LEN(p);
6293: n = NV(p);
6294: m = (NMV)(((char *)BDY(p))+nmv_adv*(len-1));
6295: for ( j = len-1, s = 0; j >= 0; j--, NMV_PREV(m) ) {
6296: if ( mod == -1 ) {
6297: e = IFTOF(CM(m)); MKGFS(e,gfs); c = (P)gfs;
6298: } else if ( mod == -2 ) {
6299: c = (P)CZ(m);
6300: } else if ( mod > 0 ) {
1.6 noro 6301: STOZ(CM(m),q); c = (P)q;
1.1 noro 6302: } else
6303: c = CP(m);
6304: d = DL(m);
6305: for ( i = 0, t = c, tvl = dvl; i < n; tvl = NEXT(tvl), i++ ) {
1.6 noro 6306: MKV(tvl->v,r); e = GET_EXP(d,i); STOZ(e,q);
1.1 noro 6307: pwrp(vl,r,q,&u); mulp(vl,t,u,&w); t = w;
6308: }
6309: addp(vl,s,t,&u); s = u;
6310: }
6311: return s;
6312: }
6313: }
6314:
6315: LIST ndvtopl(int mod,VL vl,VL dvl,NDV p,int rank)
6316: {
6317: VL tvl;
6318: int len,n,j,i,e;
6319: NMV m;
6320: Z q;
6321: P c;
6322: UINT *d;
6323: P s,r,u,t,w;
6324: GFS gfs;
6325: P *a;
6326: LIST l;
6327: NODE nd,nd1;
6328:
6329: if ( !p ) return 0;
6330: else {
6331: a = (P *)MALLOC((rank+1)*sizeof(P));
6332: for ( i = 0; i <= rank; i++ ) a[i] = 0;
6333: len = LEN(p);
6334: n = NV(p);
6335: m = (NMV)(((char *)BDY(p))+nmv_adv*(len-1));
6336: for ( j = len-1; j >= 0; j--, NMV_PREV(m) ) {
6337: if ( mod == -1 ) {
6338: e = IFTOF(CM(m)); MKGFS(e,gfs); c = (P)gfs;
6339: } else if ( mod ) {
1.6 noro 6340: STOZ(CM(m),q); c = (P)q;
1.1 noro 6341: } else
6342: c = CP(m);
6343: d = DL(m);
6344: for ( i = 0, t = c, tvl = dvl; i < n; tvl = NEXT(tvl), i++ ) {
1.6 noro 6345: MKV(tvl->v,r); e = GET_EXP(d,i); STOZ(e,q);
1.1 noro 6346: pwrp(vl,r,q,&u); mulp(vl,t,u,&w); t = w;
6347: }
6348: addp(vl,a[MPOS(d)],t,&u); a[MPOS(d)] = u;
6349: }
6350: nd = 0;
6351: for ( i = rank; i > 0; i-- ) {
6352: MKNODE(nd1,a[i],nd); nd = nd1;
6353: }
6354: MKLIST(l,nd);
6355: return l;
6356: }
6357: }
6358:
6359: NDV ndtondv(int mod,ND p)
6360: {
6361: NDV d;
6362: NMV m,m0;
6363: NM t;
6364: int i,len;
6365:
6366: if ( !p ) return 0;
6367: len = LEN(p);
6368: if ( mod > 0 || mod == -1 )
6369: m0 = m = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(len*nmv_adv);
6370: else
6371: m0 = m = MALLOC(len*nmv_adv);
6372: #if 0
6373: ndv_alloc += nmv_adv*len;
6374: #endif
6375: for ( t = BDY(p), i = 0; t; t = NEXT(t), i++, NMV_ADV(m) ) {
6376: ndl_copy(DL(t),DL(m));
1.6 noro 6377: CZ(m) = CZ(t);
1.1 noro 6378: }
6379: MKNDV(NV(p),m0,len,d);
6380: SG(d) = SG(p);
1.24 noro 6381: d->sig = p->sig;
1.1 noro 6382: return d;
6383: }
6384:
1.16 noro 6385: static int dmm_comp_nv;
6386:
6387: int dmm_comp(DMM *a,DMM *b)
6388: {
6389: return -compdmm(dmm_comp_nv,*a,*b);
6390: }
6391:
6392: void dmm_sort_by_ord(DMM *a,int len,int nv)
6393: {
6394: dmm_comp_nv = nv;
6395: qsort(a,len,sizeof(DMM),(int (*)(const void *,const void *))dmm_comp);
6396: }
6397:
6398: void dpm_sort(DPM p,DPM *rp)
6399: {
6400: DMM t,t1;
6401: int len,i,n;
6402: DMM *a;
6403: DPM d;
6404:
6405: if ( !p ) *rp = 0;
6406: for ( t = BDY(p), len = 0; t; t = NEXT(t), len++ );
6407: a = (DMM *)MALLOC(len*sizeof(DMM));
6408: for ( i = 0, t = BDY(p); i < len; i++, t = NEXT(t) ) a[i] = t;
6409: n = p->nv;
6410: dmm_sort_by_ord(a,len,n);
6411: t = 0;
6412: for ( i = len-1; i >= 0; i-- ) {
6413: NEWDMM(t1);
6414: t1->c = a[i]->c;
6415: t1->dl = a[i]->dl;
6416: t1->pos = a[i]->pos;
6417: t1->next = t;
6418: t = t1;
6419: }
6420: MKDPM(n,t,d);
6421: SG(d) = SG(p);
6422: *rp = d;
6423: }
6424:
1.18 noro 6425: int dpm_comp(DPM *a,DPM *b)
6426: {
1.22 noro 6427: return -compdpm(CO,*a,*b);
1.18 noro 6428: }
6429:
6430: NODE dpm_sort_list(NODE l)
6431: {
6432: int i,len;
6433: NODE t,t1;
6434: DPM *a;
6435:
6436: len = length(l);
6437: a = (DPM *)MALLOC(len*sizeof(DPM));
6438: for ( t = l, i = 0; i < len; i++, t = NEXT(t) ) a[i] = (DPM)BDY(t);
6439: qsort(a,len,sizeof(DPM),(int (*)(const void *,const void *))dpm_comp);
6440: t = 0;
6441: for ( i = len-1; i >= 0; i-- ) {
6442: MKNODE(t1,(pointer)a[i],t); t = t1;
6443: }
6444: return t;
6445: }
6446:
1.20 noro 6447: int nmv_comp(NMV a,NMV b)
6448: {
1.21 noro 6449: int t;
6450: t = DL_COMPARE(a->dl,b->dl);
6451: return -t;
1.20 noro 6452: }
6453:
1.16 noro 6454: NDV dpmtondv(int mod,DPM p)
6455: {
6456: NDV d;
6457: NMV m,m0;
6458: DMM t;
6459: DMM *a;
6460: int i,len,n;
6461:
6462: if ( !p ) return 0;
6463: for ( t = BDY(p), len = 0; t; t = NEXT(t), len++ );
6464: a = (DMM *)MALLOC(len*sizeof(DMM));
6465: for ( i = 0, t = BDY(p); i < len; i++, t = NEXT(t) ) a[i] = t;
6466: n = p->nv;
6467: dmm_sort_by_ord(a,len,n);
6468: if ( mod > 0 || mod == -1 )
6469: m0 = m = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(len*nmv_adv);
6470: else
6471: m0 = m = MALLOC(len*nmv_adv);
6472: #if 0
6473: ndv_alloc += nmv_adv*len;
6474: #endif
6475: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
6476: dltondl(n,a[i]->dl,DL(m));
6477: MPOS(DL(m)) = a[i]->pos;
1.20 noro 6478: TD(DL(m)) = ndl_weight(DL(m));
1.16 noro 6479: CZ(m) = (Z)a[i]->c;
6480: }
1.20 noro 6481: qsort(m0,len,nmv_adv,(int (*)(const void *,const void *))nmv_comp);
1.16 noro 6482: MKNDV(NV(p),m0,len,d);
6483: SG(d) = SG(p);
6484: return d;
6485: }
6486:
1.1 noro 6487: ND ndvtond(int mod,NDV p)
6488: {
6489: ND d;
6490: NM m,m0;
6491: NMV t;
6492: int i,len;
6493:
6494: if ( !p ) return 0;
6495: m0 = 0;
6496: len = p->len;
6497: for ( t = BDY(p), i = 0; i < len; NMV_ADV(t), i++ ) {
6498: NEXTNM(m0,m);
6499: ndl_copy(DL(t),DL(m));
1.6 noro 6500: CZ(m) = CZ(t);
1.1 noro 6501: }
6502: NEXT(m) = 0;
6503: MKND(NV(p),m0,len,d);
6504: SG(d) = SG(p);
6505: return d;
6506: }
6507:
6508: DP ndvtodp(int mod,NDV p)
6509: {
6510: MP m,m0;
6511: DP d;
6512: NMV t;
6513: int i,len;
6514:
6515: if ( !p ) return 0;
6516: m0 = 0;
6517: len = p->len;
6518: for ( t = BDY(p), i = 0; i < len; NMV_ADV(t), i++ ) {
6519: NEXTMP(m0,m);
6520: m->dl = ndltodl(nd_nvar,DL(t));
6521: m->c = (Obj)ndctop(mod,t->c);
6522: }
6523: NEXT(m) = 0;
6524: MKDP(nd_nvar,m0,d);
6525: SG(d) = SG(p);
6526: return d;
6527: }
6528:
1.16 noro 6529: DPM ndvtodpm(int mod,NDV p)
6530: {
6531: DMM m,m0;
6532: DPM d;
6533: NMV t;
6534: int i,len;
6535:
6536: if ( !p ) return 0;
6537: m0 = 0;
6538: len = p->len;
6539: for ( t = BDY(p), i = 0; i < len; NMV_ADV(t), i++ ) {
6540: NEXTDMM(m0,m);
6541: m->dl = ndltodl(nd_nvar,DL(t));
6542: m->c = (Obj)ndctop(mod,t->c);
6543: m->pos = MPOS(DL(t));
6544: }
6545: NEXT(m) = 0;
6546: MKDPM(nd_nvar,m0,d);
6547: SG(d) = SG(p);
6548: return d;
6549: }
6550:
6551:
1.1 noro 6552: DP ndtodp(int mod,ND p)
6553: {
6554: MP m,m0;
6555: DP d;
6556: NM t;
6557: int i,len;
6558:
6559: if ( !p ) return 0;
6560: m0 = 0;
6561: len = p->len;
6562: for ( t = BDY(p); t; t = NEXT(t) ) {
6563: NEXTMP(m0,m);
6564: m->dl = ndltodl(nd_nvar,DL(t));
6565: m->c = (Obj)ndctop(mod,t->c);
6566: }
6567: NEXT(m) = 0;
6568: MKDP(nd_nvar,m0,d);
6569: SG(d) = SG(p);
6570: return d;
6571: }
6572:
6573: void ndv_print(NDV p)
6574: {
6575: NMV m;
6576: int i,len;
6577:
6578: if ( !p ) printf("0\n");
6579: else {
6580: len = LEN(p);
6581: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
6582: if ( CM(m) & 0x80000000 ) printf("+@_%d*",IFTOF(CM(m)));
6583: else printf("+%d*",CM(m));
6584: ndl_print(DL(m));
6585: }
6586: printf("\n");
6587: }
6588: }
6589:
6590: void ndv_print_q(NDV p)
6591: {
6592: NMV m;
6593: int i,len;
6594:
6595: if ( !p ) printf("0\n");
6596: else {
6597: len = LEN(p);
6598: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
6599: printf("+");
1.6 noro 6600: printexpr(CO,(Obj)CZ(m));
1.1 noro 6601: printf("*");
6602: ndl_print(DL(m));
6603: }
6604: printf("\n");
6605: }
6606: }
6607:
6608: NODE ndv_reducebase(NODE x,int *perm)
6609: {
6610: int len,i,j;
6611: NDVI w;
6612: NODE t,t0;
6613:
6614: len = length(x);
6615: w = (NDVI)MALLOC(len*sizeof(struct oNDVI));
6616: for ( i = 0, t = x; i < len; i++, t = NEXT(t) ) {
6617: w[i].p = BDY(t); w[i].i = perm[i];
6618: }
6619: for ( i = 0; i < len; i++ ) {
6620: for ( j = 0; j < i; j++ ) {
6621: if ( w[i].p && w[j].p ) {
6622: if ( ndl_reducible(HDL(w[i].p),HDL(w[j].p)) ) w[i].p = 0;
6623: else if ( ndl_reducible(HDL(w[j].p),HDL(w[i].p)) ) w[j].p = 0;
6624: }
6625: }
6626: }
6627: for ( i = j = 0, t0 = 0; i < len; i++ ) {
6628: if ( w[i].p ) {
6629: NEXTNODE(t0,t); BDY(t) = (pointer)w[i].p;
6630: perm[j++] = w[i].i;
6631: }
6632: }
6633: NEXT(t) = 0; x = t0;
6634: return x;
6635: }
6636:
6637: /* XXX incomplete */
6638:
1.21 noro 6639: extern DMMstack dmm_stack;
6640: int ndl_module_schreyer_compare(UINT *a,UINT *b);
1.16 noro 6641:
1.1 noro 6642: void nd_init_ord(struct order_spec *ord)
6643: {
6644: nd_module = (ord->id >= 256);
6645: if ( nd_module ) {
6646: nd_dcomp = -1;
1.21 noro 6647: nd_module_ordtype = ord->module_ordtype;
1.1 noro 6648: nd_pot_nelim = ord->pot_nelim;
6649: nd_poly_weight_len = ord->nv;
6650: nd_poly_weight = ord->top_weight;
6651: nd_module_rank = ord->module_rank;
6652: nd_module_weight = ord->module_top_weight;
6653: }
6654: nd_matrix = 0;
6655: nd_matrix_len = 0;
6656: switch ( ord->id ) {
6657: case 0:
6658: switch ( ord->ord.simple ) {
6659: case 0:
6660: nd_dcomp = 1;
6661: nd_isrlex = 1;
6662: break;
6663: case 1:
6664: nd_dcomp = 1;
6665: nd_isrlex = 0;
6666: break;
6667: case 2:
6668: nd_dcomp = 0;
6669: nd_isrlex = 0;
6670: ndl_compare_function = ndl_lex_compare;
6671: break;
6672: case 11:
6673: /* XXX */
6674: nd_dcomp = 0;
6675: nd_isrlex = 1;
6676: ndl_compare_function = ndl_ww_lex_compare;
6677: break;
6678: default:
6679: error("nd_gr : unsupported order");
6680: }
6681: break;
6682: case 1:
6683: /* block order */
6684: /* XXX */
6685: nd_dcomp = -1;
6686: nd_isrlex = 0;
6687: ndl_compare_function = ndl_block_compare;
6688: break;
6689: case 2:
6690: /* matrix order */
6691: /* XXX */
6692: nd_dcomp = -1;
6693: nd_isrlex = 0;
6694: nd_matrix_len = ord->ord.matrix.row;
6695: nd_matrix = ord->ord.matrix.matrix;
6696: ndl_compare_function = ndl_matrix_compare;
6697: break;
6698: case 3:
6699: /* composite order */
6700: nd_dcomp = -1;
6701: nd_isrlex = 0;
6702: nd_worb_len = ord->ord.composite.length;
6703: nd_worb = ord->ord.composite.w_or_b;
6704: ndl_compare_function = ndl_composite_compare;
6705: break;
6706:
6707: /* module order */
6708: case 256:
6709: switch ( ord->ord.simple ) {
6710: case 0:
1.21 noro 6711: nd_dcomp = 0;
1.1 noro 6712: nd_isrlex = 1;
1.21 noro 6713: ndl_compare_function = ndl_module_glex_compare;
1.1 noro 6714: break;
6715: case 1:
1.21 noro 6716: nd_dcomp = 0;
1.1 noro 6717: nd_isrlex = 0;
6718: ndl_compare_function = ndl_module_glex_compare;
6719: break;
6720: case 2:
1.21 noro 6721: nd_dcomp = 0;
1.1 noro 6722: nd_isrlex = 0;
1.21 noro 6723: ndl_compare_function = ndl_module_compare;
6724: ndl_base_compare_function = ndl_lex_compare;
1.1 noro 6725: break;
6726: default:
1.21 noro 6727: error("nd_init_ord : unsupported order");
1.1 noro 6728: }
6729: break;
6730: case 257:
6731: /* block order */
6732: nd_isrlex = 0;
1.21 noro 6733: ndl_compare_function = ndl_module_compare;
6734: ndl_base_compare_function = ndl_block_compare;
1.1 noro 6735: break;
6736: case 258:
6737: /* matrix order */
6738: nd_isrlex = 0;
6739: nd_matrix_len = ord->ord.matrix.row;
6740: nd_matrix = ord->ord.matrix.matrix;
1.21 noro 6741: ndl_compare_function = ndl_module_compare;
6742: ndl_base_compare_function = ndl_matrix_compare;
1.1 noro 6743: break;
6744: case 259:
6745: /* composite order */
6746: nd_isrlex = 0;
6747: nd_worb_len = ord->ord.composite.length;
6748: nd_worb = ord->ord.composite.w_or_b;
1.21 noro 6749: ndl_compare_function = ndl_module_compare;
6750: ndl_base_compare_function = ndl_composite_compare;
6751: break;
6752: case 300:
6753: /* schreyer order */
6754: if ( ord->base->id != 256 )
6755: error("nd_init_ord : unsupported base order");
6756: ndl_compare_function = ndl_module_schreyer_compare;
6757: dmm_stack = ord->dmmstack;
6758: switch ( ord->base->ord.simple ) {
6759: case 0:
6760: nd_isrlex = 1;
6761: ndl_base_compare_function = ndl_glex_compare;
6762: dl_base_compare_function = cmpdl_revgradlex;
6763: break;
6764: case 1:
6765: nd_isrlex = 0;
6766: ndl_base_compare_function = ndl_glex_compare;
6767: dl_base_compare_function = cmpdl_gradlex;
6768: break;
6769: case 2:
6770: nd_isrlex = 0;
6771: ndl_base_compare_function = ndl_lex_compare;
6772: dl_base_compare_function = cmpdl_lex;
6773: break;
6774: default:
6775: error("nd_init_ord : unsupported order");
6776: }
1.1 noro 6777: break;
6778: }
6779: nd_ord = ord;
6780: }
6781:
6782: BlockMask nd_create_blockmask(struct order_spec *ord)
6783: {
6784: int n,i,j,s,l;
6785: UINT *t;
6786: BlockMask bm;
6787:
6788: /* we only create mask table for block order */
6789: if ( ord->id != 1 && ord->id != 257 )
6790: return 0;
6791: n = ord->ord.block.length;
6792: bm = (BlockMask)MALLOC(sizeof(struct oBlockMask));
6793: bm->n = n;
6794: bm->order_pair = ord->ord.block.order_pair;
6795: bm->mask = (UINT **)MALLOC(n*sizeof(UINT *));
6796: for ( i = 0, s = 0; i < n; i++ ) {
6797: bm->mask[i] = t = (UINT *)MALLOC_ATOMIC(nd_wpd*sizeof(UINT));
6798: for ( j = 0; j < nd_wpd; j++ ) t[j] = 0;
6799: l = bm->order_pair[i].length;
6800: for ( j = 0; j < l; j++, s++ ) PUT_EXP(t,s,nd_mask0);
6801: }
6802: return bm;
6803: }
6804:
6805: EPOS nd_create_epos(struct order_spec *ord)
6806: {
6807: int i,j,l,s,ord_l,ord_o;
6808: EPOS epos;
6809: struct order_pair *op;
6810:
6811: epos = (EPOS)MALLOC_ATOMIC(nd_nvar*sizeof(struct oEPOS));
6812: switch ( ord->id ) {
1.21 noro 6813: case 0: case 256: case 300:
1.1 noro 6814: if ( nd_isrlex ) {
6815: for ( i = 0; i < nd_nvar; i++ ) {
6816: epos[i].i = nd_exporigin + (nd_nvar-1-i)/nd_epw;
6817: epos[i].s = (nd_epw-((nd_nvar-1-i)%nd_epw)-1)*nd_bpe;
6818: }
6819: } else {
6820: for ( i = 0; i < nd_nvar; i++ ) {
6821: epos[i].i = nd_exporigin + i/nd_epw;
6822: epos[i].s = (nd_epw-(i%nd_epw)-1)*nd_bpe;
6823: }
6824: }
6825: break;
6826: case 1: case 257:
6827: /* block order */
6828: l = ord->ord.block.length;
6829: op = ord->ord.block.order_pair;
6830: for ( j = 0, s = 0; j < l; j++ ) {
6831: ord_o = op[j].order;
6832: ord_l = op[j].length;
6833: if ( !ord_o )
6834: for ( i = 0; i < ord_l; i++ ) {
6835: epos[s+i].i = nd_exporigin + (s+ord_l-i-1)/nd_epw;
6836: epos[s+i].s = (nd_epw-((s+ord_l-i-1)%nd_epw)-1)*nd_bpe;
6837: }
6838: else
6839: for ( i = 0; i < ord_l; i++ ) {
6840: epos[s+i].i = nd_exporigin + (s+i)/nd_epw;
6841: epos[s+i].s = (nd_epw-((s+i)%nd_epw)-1)*nd_bpe;
6842: }
6843: s += ord_l;
6844: }
6845: break;
6846: case 2:
6847: /* matrix order */
6848: case 3:
6849: /* composite order */
6850: default:
6851: for ( i = 0; i < nd_nvar; i++ ) {
6852: epos[i].i = nd_exporigin + i/nd_epw;
6853: epos[i].s = (nd_epw-(i%nd_epw)-1)*nd_bpe;
6854: }
6855: break;
6856: }
6857: return epos;
6858: }
6859:
6860: /* external interface */
6861:
6862: void nd_nf_p(Obj f,LIST g,LIST v,int m,struct order_spec *ord,Obj *rp)
6863: {
6864: NODE t,in0,in;
6865: ND ndf,nf;
6866: NDV ndvf;
6867: VL vv,tv;
6868: int stat,nvar,max,mrank;
6869: union oNDC dn;
6870: Q cont;
6871: P pp;
6872: LIST ppl;
6873:
6874: if ( !f ) {
6875: *rp = 0;
6876: return;
6877: }
6878: pltovl(v,&vv);
6879: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
6880:
6881: /* max=65536 implies nd_bpe=32 */
6882: max = 65536;
6883:
6884: nd_module = 0;
6885: /* nd_module will be set if ord is a module ordering */
6886: nd_init_ord(ord);
6887: nd_setup_parameters(nvar,max);
6888: if ( nd_module && OID(f) != O_LIST )
6889: error("nd_nf_p : the first argument must be a list");
6890: if ( nd_module ) mrank = length(BDY((LIST)f));
6891: /* conversion to ndv */
6892: for ( in0 = 0, t = BDY(g); t; t = NEXT(t) ) {
6893: NEXTNODE(in0,in);
6894: if ( nd_module ) {
6895: if ( !BDY(t) || OID(BDY(t)) != O_LIST
6896: || length(BDY((LIST)BDY(t))) != mrank )
6897: error("nd_nf_p : inconsistent basis element");
6898: if ( !m ) pltozpl((LIST)BDY(t),&cont,&ppl);
6899: else ppl = (LIST)BDY(t);
6900: BDY(in) = (pointer)pltondv(CO,vv,ppl);
6901: } else {
6902: if ( !m ) ptozp((P)BDY(t),1,&cont,&pp);
6903: else pp = (P)BDY(t);
6904: BDY(in) = (pointer)ptondv(CO,vv,pp);
6905: }
6906: if ( m ) ndv_mod(m,(NDV)BDY(in));
6907: }
6908: if ( in0 ) NEXT(in) = 0;
6909:
6910: if ( nd_module ) ndvf = pltondv(CO,vv,(LIST)f);
6911: else ndvf = ptondv(CO,vv,(P)f);
6912: if ( m ) ndv_mod(m,ndvf);
6913: ndf = (pointer)ndvtond(m,ndvf);
6914:
6915: /* dont sort, dont removecont */
1.24 noro 6916: ndv_setup(m,0,in0,1,1,0);
1.1 noro 6917: nd_scale=2;
1.6 noro 6918: stat = nd_nf(m,0,ndf,nd_ps,1,&nf);
1.1 noro 6919: if ( !stat )
6920: error("nd_nf_p : exponent too large");
6921: if ( nd_module ) *rp = (Obj)ndvtopl(m,CO,vv,ndtondv(m,nf),mrank);
6922: else *rp = (Obj)ndvtop(m,CO,vv,ndtondv(m,nf));
6923: }
6924:
6925: int nd_to_vect(int mod,UINT *s0,int n,ND d,UINT *r)
6926: {
6927: NM m;
6928: UINT *t,*s;
6929: int i;
6930:
6931: for ( i = 0; i < n; i++ ) r[i] = 0;
6932: for ( i = 0, s = s0, m = BDY(d); m; m = NEXT(m) ) {
6933: t = DL(m);
6934: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
6935: r[i] = CM(m);
6936: }
6937: for ( i = 0; !r[i]; i++ );
6938: return i;
6939: }
6940:
6941: int nd_to_vect_q(UINT *s0,int n,ND d,Z *r)
6942: {
6943: NM m;
6944: UINT *t,*s;
6945: int i;
6946:
6947: for ( i = 0; i < n; i++ ) r[i] = 0;
6948: for ( i = 0, s = s0, m = BDY(d); m; m = NEXT(m) ) {
6949: t = DL(m);
6950: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
1.6 noro 6951: r[i] = CZ(m);
1.1 noro 6952: }
6953: for ( i = 0; !r[i]; i++ );
6954: return i;
6955: }
6956:
6957: int nd_to_vect_lf(UINT *s0,int n,ND d,mpz_t *r)
6958: {
6959: NM m;
6960: UINT *t,*s;
6961: int i;
6962:
6963: for ( i = 0; i < n; i++ ) { mpz_init(r[i]); mpz_set_ui(r[i],0); }
6964: for ( i = 0, s = s0, m = BDY(d); m; m = NEXT(m) ) {
6965: t = DL(m);
6966: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
6967: mpz_set(r[i],BDY(CZ(m)));
6968: }
6969: for ( i = 0; !mpz_sgn(r[i]); i++ );
6970: return i;
6971: }
6972:
6973: unsigned long *nd_to_vect_2(UINT *s0,int n,int *s0hash,ND p)
6974: {
6975: NM m;
6976: unsigned long *v;
6977: int i,j,h,size;
6978: UINT *s,*t;
6979:
6980: size = sizeof(unsigned long)*(n+BLEN-1)/BLEN;
6981: v = (unsigned long *)MALLOC_ATOMIC_IGNORE_OFF_PAGE(size);
6982: bzero(v,size);
6983: for ( i = j = 0, s = s0, m = BDY(p); m; j++, m = NEXT(m) ) {
6984: t = DL(m);
6985: h = ndl_hash_value(t);
6986: for ( ; h != s0hash[i] || !ndl_equal(t,s); s += nd_wpd, i++ );
6987: v[i/BLEN] |= 1L <<(i%BLEN);
6988: }
6989: return v;
6990: }
6991:
6992: int nd_nm_to_vect_2(UINT *s0,int n,int *s0hash,NDV p,NM m,unsigned long *v)
6993: {
6994: NMV mr;
6995: UINT *d,*t,*s;
6996: int i,j,len,h,head;
6997:
6998: d = DL(m);
6999: len = LEN(p);
7000: t = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
7001: for ( i = j = 0, s = s0, mr = BDY(p); j < len; j++, NMV_ADV(mr) ) {
7002: ndl_add(d,DL(mr),t);
7003: h = ndl_hash_value(t);
7004: for ( ; h != s0hash[i] || !ndl_equal(t,s); s += nd_wpd, i++ );
7005: if ( j == 0 ) head = i;
7006: v[i/BLEN] |= 1L <<(i%BLEN);
7007: }
7008: return head;
7009: }
7010:
7011: Z *nm_ind_pair_to_vect(int mod,UINT *s0,int n,NM_ind_pair pair)
7012: {
7013: NM m;
7014: NMV mr;
7015: UINT *d,*t,*s;
7016: NDV p;
7017: int i,j,len;
7018: Z *r;
7019:
7020: m = pair->mul;
7021: d = DL(m);
7022: p = nd_ps[pair->index];
7023: len = LEN(p);
7024: r = (Z *)CALLOC(n,sizeof(Q));
7025: t = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
7026: for ( i = j = 0, s = s0, mr = BDY(p); j < len; j++, NMV_ADV(mr) ) {
7027: ndl_add(d,DL(mr),t);
7028: for ( ; !ndl_equal(t,s); s += nd_wpd, i++ );
1.6 noro 7029: r[i] = CZ(mr);
1.1 noro 7030: }
7031: return r;
7032: }
7033:
1.11 noro 7034: IndArray nm_ind_pair_to_vect_compress(int trace,UINT *s0,int n,NM_ind_pair pair,int start)
1.1 noro 7035: {
7036: NM m;
7037: NMV mr;
1.11 noro 7038: UINT *d,*t,*s,*u;
1.1 noro 7039: NDV p;
7040: unsigned char *ivc;
7041: unsigned short *ivs;
7042: UINT *v,*ivi,*s0v;
1.11 noro 7043: int i,j,len,prev,diff,cdiff,h,st,ed,md,c;
1.1 noro 7044: IndArray r;
7045:
7046: m = pair->mul;
7047: d = DL(m);
7048: if ( trace )
7049: p = nd_demand?nd_ps_trace_sym[pair->index]:nd_ps_trace[pair->index];
7050: else
7051: p = nd_demand?nd_ps_sym[pair->index]:nd_ps[pair->index];
7052:
7053: len = LEN(p);
7054: t = (UINT *)MALLOC(nd_wpd*sizeof(UINT));
7055: v = (unsigned int *)MALLOC(len*sizeof(unsigned int));
1.11 noro 7056: for ( prev = start, mr = BDY(p), j = 0; j < len; j++, NMV_ADV(mr) ) {
7057: ndl_add(d,DL(mr),t);
7058: st = prev;
7059: ed = n;
7060: while ( ed > st ) {
7061: md = (st+ed)/2;
7062: u = s0+md*nd_wpd;
7063: c = DL_COMPARE(u,t);
7064: if ( c == 0 ) break;
7065: else if ( c > 0 ) st = md;
7066: else ed = md;
7067: }
7068: prev = v[j] = md;
1.1 noro 7069: }
7070: r = (IndArray)MALLOC(sizeof(struct oIndArray));
7071: r->head = v[0];
7072: diff = 0;
7073: for ( i = 1; i < len; i++ ) {
7074: cdiff = v[i]-v[i-1]; diff = MAX(cdiff,diff);
7075: }
7076: if ( diff < 256 ) {
7077: r->width = 1;
7078: ivc = (unsigned char *)MALLOC_ATOMIC(len*sizeof(unsigned char));
7079: r->index.c = ivc;
7080: for ( i = 1, ivc[0] = 0; i < len; i++ ) ivc[i] = v[i]-v[i-1];
7081: } else if ( diff < 65536 ) {
7082: r->width = 2;
7083: ivs = (unsigned short *)MALLOC_ATOMIC(len*sizeof(unsigned short));
7084: r->index.s = ivs;
7085: for ( i = 1, ivs[0] = 0; i < len; i++ ) ivs[i] = v[i]-v[i-1];
7086: } else {
7087: r->width = 4;
7088: ivi = (unsigned int *)MALLOC_ATOMIC(len*sizeof(unsigned int));
7089: r->index.i = ivi;
7090: for ( i = 1, ivi[0] = 0; i < len; i++ ) ivi[i] = v[i]-v[i-1];
7091: }
7092: return r;
7093: }
7094:
7095: int compress_array(Z *svect,Z *cvect,int n)
7096: {
7097: int i,j;
7098:
7099: for ( i = j = 0; i < n; i++ )
7100: if ( svect[i] ) cvect[j++] = svect[i];
7101: return j;
7102: }
7103:
7104: void expand_array(Z *svect,Z *cvect,int n)
7105: {
7106: int i,j;
7107:
7108: for ( i = j = 0; j < n; i++ )
7109: if ( svect[i] ) svect[i] = cvect[j++];
7110: }
7111:
1.8 noro 7112: #if 0
1.1 noro 7113: int ndv_reduce_vect_q(Z *svect,int trace,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
7114: {
7115: int i,j,k,len,pos,prev,nz;
7116: Z cs,mcs,c1,c2,cr,gcd,t;
7117: IndArray ivect;
7118: unsigned char *ivc;
7119: unsigned short *ivs;
7120: unsigned int *ivi;
7121: NDV redv;
7122: NMV mr;
7123: NODE rp;
7124: int maxrs;
7125: double hmag;
7126: Z *cvect;
1.3 noro 7127: int l;
1.1 noro 7128:
7129: maxrs = 0;
7130: for ( i = 0; i < col && !svect[i]; i++ );
7131: if ( i == col ) return maxrs;
7132: hmag = p_mag((P)svect[i])*nd_scale;
7133: cvect = (Z *)MALLOC(col*sizeof(Q));
7134: for ( i = 0; i < nred; i++ ) {
7135: ivect = imat[i];
7136: k = ivect->head;
7137: if ( svect[k] ) {
7138: maxrs = MAX(maxrs,rp0[i]->sugar);
7139: redv = nd_demand?ndv_load(rp0[i]->index)
7140: :(trace?nd_ps_trace[rp0[i]->index]:nd_ps[rp0[i]->index]);
7141: len = LEN(redv); mr = BDY(redv);
1.6 noro 7142: igcd_cofactor(svect[k],CZ(mr),&gcd,&cs,&cr);
1.1 noro 7143: chsgnz(cs,&mcs);
7144: if ( !UNIQ(cr) ) {
7145: for ( j = 0; j < col; j++ ) {
7146: mulz(svect[j],cr,&c1); svect[j] = c1;
7147: }
7148: }
7149: svect[k] = 0; prev = k;
7150: switch ( ivect->width ) {
7151: case 1:
7152: ivc = ivect->index.c;
7153: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7154: pos = prev+ivc[j]; prev = pos;
1.6 noro 7155: muladdtoz(CZ(mr),mcs,&svect[pos]);
1.1 noro 7156: }
7157: break;
7158: case 2:
7159: ivs = ivect->index.s;
7160: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7161: pos = prev+ivs[j]; prev = pos;
1.6 noro 7162: muladdtoz(CZ(mr),mcs,&svect[pos]);
1.1 noro 7163: }
7164: break;
7165: case 4:
7166: ivi = ivect->index.i;
7167: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7168: pos = prev+ivi[j]; prev = pos;
1.6 noro 7169: muladdtoz(CZ(mr),mcs,&svect[pos]);
1.1 noro 7170: }
7171: break;
7172: }
7173: for ( j = k+1; j < col && !svect[j]; j++ );
7174: if ( j == col ) break;
7175: if ( hmag && ((double)p_mag((P)svect[j]) > hmag) ) {
7176: nz = compress_array(svect,cvect,col);
7177: removecont_array((P *)cvect,nz,1);
7178: expand_array(svect,cvect,nz);
7179: hmag = ((double)p_mag((P)svect[j]))*nd_scale;
7180: }
7181: }
7182: }
7183: nz = compress_array(svect,cvect,col);
7184: removecont_array((P *)cvect,nz,1);
7185: expand_array(svect,cvect,nz);
7186: if ( DP_Print ) {
7187: fprintf(asir_out,"-"); fflush(asir_out);
7188: }
7189: return maxrs;
7190: }
1.4 noro 7191: #else
1.9 noro 7192:
1.4 noro 7193: /* direct mpz version */
7194: int ndv_reduce_vect_q(Z *svect0,int trace,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
7195: {
7196: int i,j,k,len,pos,prev;
7197: mpz_t cs,cr,gcd;
7198: IndArray ivect;
7199: unsigned char *ivc;
7200: unsigned short *ivs;
7201: unsigned int *ivi;
7202: NDV redv;
7203: NMV mr;
7204: NODE rp;
7205: int maxrs;
7206: double hmag;
7207: int l;
1.13 noro 7208: static mpz_t *svect;
7209: static int svect_len=0;
1.4 noro 7210:
7211: maxrs = 0;
7212: for ( i = 0; i < col && !svect0[i]; i++ );
7213: if ( i == col ) return maxrs;
7214: hmag = p_mag((P)svect0[i])*nd_scale;
1.13 noro 7215: if ( col > svect_len ) {
7216: svect = (mpz_t *)MALLOC(col*sizeof(mpz_t));
7217: svect_len = col;
7218: }
1.4 noro 7219: for ( i = 0; i < col; i++ ) {
7220: mpz_init(svect[i]);
7221: if ( svect0[i] )
7222: mpz_set(svect[i],BDY(svect0[i]));
7223: else
7224: mpz_set_ui(svect[i],0);
7225: }
7226: mpz_init(gcd); mpz_init(cs); mpz_init(cr);
7227: for ( i = 0; i < nred; i++ ) {
7228: ivect = imat[i];
7229: k = ivect->head;
7230: if ( mpz_sgn(svect[k]) ) {
7231: maxrs = MAX(maxrs,rp0[i]->sugar);
7232: redv = nd_demand?ndv_load(rp0[i]->index)
7233: :(trace?nd_ps_trace[rp0[i]->index]:nd_ps[rp0[i]->index]);
7234: len = LEN(redv); mr = BDY(redv);
1.6 noro 7235: mpz_gcd(gcd,svect[k],BDY(CZ(mr)));
1.4 noro 7236: mpz_div(cs,svect[k],gcd);
1.6 noro 7237: mpz_div(cr,BDY(CZ(mr)),gcd);
1.4 noro 7238: mpz_neg(cs,cs);
1.9 noro 7239: if ( MUNIMPZ(cr) )
7240: for ( j = 0; j < col; j++ ) mpz_neg(svect[j],svect[j]);
7241: else if ( !UNIMPZ(cr) )
7242: for ( j = 0; j < col; j++ ) {
7243: if ( mpz_sgn(svect[j]) ) mpz_mul(svect[j],svect[j],cr);
7244: }
1.4 noro 7245: mpz_set_ui(svect[k],0);
7246: prev = k;
7247: switch ( ivect->width ) {
7248: case 1:
7249: ivc = ivect->index.c;
7250: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7251: pos = prev+ivc[j]; prev = pos;
1.6 noro 7252: mpz_addmul(svect[pos],BDY(CZ(mr)),cs);
1.4 noro 7253: }
7254: break;
7255: case 2:
7256: ivs = ivect->index.s;
7257: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7258: pos = prev+ivs[j]; prev = pos;
1.6 noro 7259: mpz_addmul(svect[pos],BDY(CZ(mr)),cs);
1.4 noro 7260: }
7261: break;
7262: case 4:
7263: ivi = ivect->index.i;
7264: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7265: pos = prev+ivi[j]; prev = pos;
1.6 noro 7266: mpz_addmul(svect[pos],BDY(CZ(mr)),cs);
1.4 noro 7267: }
7268: break;
7269: }
7270: for ( j = k+1; j < col && !svect[j]; j++ );
7271: if ( j == col ) break;
7272: if ( hmag && ((double)mpz_sizeinbase(svect[j],2) > hmag) ) {
7273: mpz_removecont_array(svect,col);
7274: hmag = ((double)mpz_sizeinbase(svect[j],2))*nd_scale;
7275: }
7276: }
7277: }
7278: mpz_removecont_array(svect,col);
7279: if ( DP_Print ) {
7280: fprintf(asir_out,"-"); fflush(asir_out);
7281: }
7282: for ( i = 0; i < col; i++ )
7283: if ( mpz_sgn(svect[i]) ) MPZTOZ(svect[i],svect0[i]);
7284: else svect0[i] = 0;
7285: return maxrs;
7286: }
7287: #endif
1.1 noro 7288:
7289: int ndv_reduce_vect(int m,UINT *svect,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
7290: {
7291: int i,j,k,len,pos,prev;
7292: UINT c,c1,c2,c3,up,lo,dmy;
7293: IndArray ivect;
7294: unsigned char *ivc;
7295: unsigned short *ivs;
7296: unsigned int *ivi;
7297: NDV redv;
7298: NMV mr;
7299: NODE rp;
7300: int maxrs;
7301:
7302: maxrs = 0;
7303: for ( i = 0; i < nred; i++ ) {
7304: ivect = imat[i];
7305: k = ivect->head; svect[k] %= m;
7306: if ( (c = svect[k]) != 0 ) {
7307: maxrs = MAX(maxrs,rp0[i]->sugar);
7308: c = m-c; redv = nd_ps[rp0[i]->index];
7309: len = LEN(redv); mr = BDY(redv);
7310: svect[k] = 0; prev = k;
7311: switch ( ivect->width ) {
7312: case 1:
7313: ivc = ivect->index.c;
7314: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7315: pos = prev+ivc[j]; c1 = CM(mr); prev = pos;
7316: if ( c1 ) {
7317: c2 = svect[pos];
7318: DMA(c1,c,c2,up,lo);
7319: if ( up ) { DSAB(m,up,lo,dmy,c3); svect[pos] = c3;
7320: } else svect[pos] = lo;
7321: }
7322: }
7323: break;
7324: case 2:
7325: ivs = ivect->index.s;
7326: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7327: pos = prev+ivs[j]; c1 = CM(mr);
7328: prev = pos;
7329: if ( c1 ) {
7330: c2 = svect[pos];
7331: DMA(c1,c,c2,up,lo);
7332: if ( up ) { DSAB(m,up,lo,dmy,c3); svect[pos] = c3;
7333: } else svect[pos] = lo;
7334: }
7335: }
7336: break;
7337: case 4:
7338: ivi = ivect->index.i;
7339: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7340: pos = prev+ivi[j]; c1 = CM(mr);
7341: 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: }
7351: }
7352: }
7353: for ( i = 0; i < col; i++ )
7354: if ( svect[i] >= (UINT)m ) svect[i] %= m;
7355: return maxrs;
7356: }
7357:
7358: int ndv_reduce_vect_sf(int m,UINT *svect,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
7359: {
7360: int i,j,k,len,pos,prev;
7361: UINT c,c1,c2,c3,up,lo,dmy;
7362: IndArray ivect;
7363: unsigned char *ivc;
7364: unsigned short *ivs;
7365: unsigned int *ivi;
7366: NDV redv;
7367: NMV mr;
7368: NODE rp;
7369: int maxrs;
7370:
7371: maxrs = 0;
7372: for ( i = 0; i < nred; i++ ) {
7373: ivect = imat[i];
7374: k = ivect->head;
7375: if ( (c = svect[k]) != 0 ) {
7376: maxrs = MAX(maxrs,rp0[i]->sugar);
7377: c = _chsgnsf(c); redv = nd_ps[rp0[i]->index];
7378: len = LEN(redv); mr = BDY(redv);
7379: svect[k] = 0; prev = k;
7380: switch ( ivect->width ) {
7381: case 1:
7382: ivc = ivect->index.c;
7383: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7384: pos = prev+ivc[j]; prev = pos;
7385: svect[pos] = _addsf(_mulsf(CM(mr),c),svect[pos]);
7386: }
7387: break;
7388: case 2:
7389: ivs = ivect->index.s;
7390: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7391: pos = prev+ivs[j]; prev = pos;
7392: svect[pos] = _addsf(_mulsf(CM(mr),c),svect[pos]);
7393: }
7394: break;
7395: case 4:
7396: ivi = ivect->index.i;
7397: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7398: pos = prev+ivi[j]; prev = pos;
7399: svect[pos] = _addsf(_mulsf(CM(mr),c),svect[pos]);
7400: }
7401: break;
7402: }
7403: }
7404: }
7405: return maxrs;
7406: }
7407:
7408: ND nd_add_lf(ND p1,ND p2)
7409: {
7410: int n,c,can;
7411: ND r;
7412: NM m1,m2,mr0,mr,s;
7413: Z t;
7414:
7415: if ( !p1 ) return p2;
7416: else if ( !p2 ) return p1;
7417: else {
7418: can = 0;
7419: for ( n = NV(p1), m1 = BDY(p1), m2 = BDY(p2), mr0 = 0; m1 && m2; ) {
7420: c = DL_COMPARE(DL(m1),DL(m2));
7421: switch ( c ) {
7422: case 0:
7423: addlf(CZ(m1),CZ(m2),&t);
7424: s = m1; m1 = NEXT(m1);
7425: if ( t ) {
7426: can++; NEXTNM2(mr0,mr,s); CZ(mr) = (t);
7427: } else {
7428: can += 2; FREENM(s);
7429: }
7430: s = m2; m2 = NEXT(m2); FREENM(s);
7431: break;
7432: case 1:
7433: s = m1; m1 = NEXT(m1); NEXTNM2(mr0,mr,s);
7434: break;
7435: case -1:
7436: s = m2; m2 = NEXT(m2); NEXTNM2(mr0,mr,s);
7437: break;
7438: }
7439: }
7440: if ( !mr0 )
7441: if ( m1 ) mr0 = m1;
7442: else if ( m2 ) mr0 = m2;
7443: else return 0;
7444: else if ( m1 ) NEXT(mr) = m1;
7445: else if ( m2 ) NEXT(mr) = m2;
7446: else NEXT(mr) = 0;
7447: BDY(p1) = mr0;
7448: SG(p1) = MAX(SG(p1),SG(p2));
7449: LEN(p1) = LEN(p1)+LEN(p2)-can;
7450: FREEND(p2);
7451: return p1;
7452: }
7453: }
7454:
7455: int ndv_reduce_vect_lf(mpz_t *svect,int trace,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
7456: {
7457: int i,j,k,len,pos,prev;
7458: mpz_t c,mc,c1;
7459: IndArray ivect;
7460: unsigned char *ivc;
7461: unsigned short *ivs;
7462: unsigned int *ivi;
7463: NDV redv;
7464: NMV mr;
7465: NODE rp;
7466: int maxrs;
7467:
7468: maxrs = 0;
7469: lf_lazy = 1;
7470: for ( i = 0; i < nred; i++ ) {
7471: ivect = imat[i];
7472: k = ivect->head;
7473: mpz_mod(svect[k],svect[k],BDY(current_mod_lf));
7474: if ( mpz_sgn(svect[k]) ) {
7475: maxrs = MAX(maxrs,rp0[i]->sugar);
7476: mpz_neg(svect[k],svect[k]);
7477: redv = trace?nd_ps_trace[rp0[i]->index]:nd_ps[rp0[i]->index];
7478: len = LEN(redv); mr = BDY(redv);
7479: prev = k;
7480: switch ( ivect->width ) {
7481: case 1:
7482: ivc = ivect->index.c;
7483: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7484: pos = prev+ivc[j]; prev = pos;
7485: mpz_addmul(svect[pos],svect[k],BDY(CZ(mr)));
7486: }
7487: break;
7488: case 2:
7489: ivs = ivect->index.s;
7490: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7491: pos = prev+ivs[j]; prev = pos;
7492: mpz_addmul(svect[pos],svect[k],BDY(CZ(mr)));
7493: }
7494: break;
7495: case 4:
7496: ivi = ivect->index.i;
7497: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
7498: pos = prev+ivi[j]; prev = pos;
7499: mpz_addmul(svect[pos],svect[k],BDY(CZ(mr)));
7500: }
7501: break;
7502: }
7503: mpz_set_ui(svect[k],0);
7504: }
7505: }
7506: lf_lazy=0;
7507: for ( i = 0; i < col; i++ ) {
7508: mpz_mod(svect[i],svect[i],BDY(current_mod_lf));
7509: }
7510: return maxrs;
7511: }
7512:
7513: int nd_gauss_elim_lf(mpz_t **mat0,int *sugar,int row,int col,int *colstat)
7514: {
7515: int i,j,k,l,rank,s;
7516: mpz_t a,a1,inv;
7517: mpz_t *t,*pivot,*pk;
7518: mpz_t **mat;
7519: struct oEGT eg0,eg1,eg_forward,eg_mod,eg_back;
7520: int size,size1;
7521:
7522: mpz_init(inv);
7523: mpz_init(a);
7524: mat = (mpz_t **)mat0;
7525: size = 0;
7526: for ( rank = 0, j = 0; j < col; j++ ) {
7527: for ( i = rank; i < row; i++ ) {
7528: mpz_mod(mat[i][j],mat[i][j],BDY(current_mod_lf));
7529: }
7530: for ( i = rank; i < row; i++ )
7531: if ( mpz_sgn(mat[i][j]) )
7532: break;
7533: if ( i == row ) {
7534: colstat[j] = 0;
7535: continue;
7536: } else
7537: colstat[j] = 1;
7538: if ( i != rank ) {
7539: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
7540: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
7541: }
7542: pivot = mat[rank];
7543: s = sugar[rank];
7544: mpz_invert(inv,pivot[j],BDY(current_mod_lf));
7545: for ( k = j, pk = pivot+k; k < col; k++, pk++ )
7546: if ( mpz_sgn(*pk) ) {
7547: mpz_mul(a,*pk,inv); mpz_mod(*pk,a,BDY(current_mod_lf));
7548: }
7549: for ( i = rank+1; i < row; i++ ) {
7550: t = mat[i];
7551: if ( mpz_sgn(t[j]) ) {
7552: sugar[i] = MAX(sugar[i],s);
7553: mpz_neg(a,t[j]);
7554: red_by_vect_lf(t+j,pivot+j,a,col-j);
7555: }
7556: }
7557: rank++;
7558: }
7559: for ( j = col-1, l = rank-1; j >= 0; j-- )
7560: if ( colstat[j] ) {
7561: pivot = mat[l];
7562: s = sugar[l];
7563: for ( k = j; k < col; k++ )
7564: mpz_mod(pivot[k],pivot[k],BDY(current_mod_lf));
7565: for ( i = 0; i < l; i++ ) {
7566: t = mat[i];
7567: if ( mpz_sgn(t[j]) ) {
7568: sugar[i] = MAX(sugar[i],s);
7569: mpz_neg(a,t[j]);
7570: red_by_vect_lf(t+j,pivot+j,a,col-j);
7571: }
7572: }
7573: l--;
7574: }
7575: for ( j = 0, l = 0; l < rank; j++ )
7576: if ( colstat[j] ) {
7577: t = mat[l];
7578: for ( k = j; k < col; k++ ) {
7579: mpz_mod(t[k],t[k],BDY(current_mod_lf));
7580: }
7581: l++;
7582: }
7583: return rank;
7584: }
7585:
7586:
7587: NDV vect_to_ndv(UINT *vect,int spcol,int col,int *rhead,UINT *s0vect)
7588: {
7589: int j,k,len;
7590: UINT *p;
7591: UINT c;
7592: NDV r;
7593: NMV mr0,mr;
7594:
7595: for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++;
7596: if ( !len ) return 0;
7597: else {
7598: mr0 = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
7599: #if 0
7600: ndv_alloc += nmv_adv*len;
7601: #endif
7602: mr = mr0;
7603: p = s0vect;
7604: for ( j = k = 0; j < col; j++, p += nd_wpd )
7605: if ( !rhead[j] ) {
7606: if ( (c = vect[k++]) != 0 ) {
7607: ndl_copy(p,DL(mr)); CM(mr) = c; NMV_ADV(mr);
7608: }
7609: }
7610: MKNDV(nd_nvar,mr0,len,r);
7611: return r;
7612: }
7613: }
7614:
7615: NDV vect_to_ndv_2(unsigned long *vect,int col,UINT *s0vect)
7616: {
7617: int j,k,len;
7618: UINT *p;
7619: NDV r;
7620: NMV mr0,mr;
7621:
7622: for ( j = 0, len = 0; j < col; j++ ) if ( vect[j/BLEN] & (1L<<(j%BLEN)) ) len++;
7623: if ( !len ) return 0;
7624: else {
7625: mr0 = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
7626: mr = mr0;
7627: p = s0vect;
7628: for ( j = 0; j < col; j++, p += nd_wpd )
7629: if ( vect[j/BLEN] & (1L<<(j%BLEN)) ) {
7630: ndl_copy(p,DL(mr)); CM(mr) = 1; NMV_ADV(mr);
7631: }
7632: MKNDV(nd_nvar,mr0,len,r);
7633: return r;
7634: }
7635: }
7636:
7637: /* for preprocessed vector */
7638:
7639: NDV vect_to_ndv_q(Z *vect,int spcol,int col,int *rhead,UINT *s0vect)
7640: {
1.6 noro 7641: int j,k,len;
7642: UINT *p;
7643: Z c;
7644: NDV r;
7645: NMV mr0,mr;
1.1 noro 7646:
1.6 noro 7647: for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++;
7648: if ( !len ) return 0;
7649: else {
7650: mr0 = (NMV)MALLOC(nmv_adv*len);
1.1 noro 7651: #if 0
1.6 noro 7652: ndv_alloc += nmv_adv*len;
1.1 noro 7653: #endif
1.6 noro 7654: mr = mr0;
7655: p = s0vect;
7656: for ( j = k = 0; j < col; j++, p += nd_wpd ) {
7657: if ( !rhead[j] ) {
7658: if ( (c = vect[k++]) != 0 ) {
7659: if ( !INT(c) )
7660: error("vect_to_ndv_q : components must be integers");
7661: ndl_copy(p,DL(mr)); CZ(mr) = c; NMV_ADV(mr);
7662: }
7663: }
1.1 noro 7664: }
1.6 noro 7665: MKNDV(nd_nvar,mr0,len,r);
7666: return r;
7667: }
1.1 noro 7668: }
7669:
7670: NDV vect_to_ndv_lf(mpz_t *vect,int spcol,int col,int *rhead,UINT *s0vect)
7671: {
7672: int j,k,len;
7673: UINT *p;
7674: mpz_t c;
7675: NDV r;
7676: NMV mr0,mr;
7677:
7678: for ( j = 0, len = 0; j < spcol; j++ ) if ( mpz_sgn(vect[j]) ) len++;
7679: if ( !len ) return 0;
7680: else {
7681: mr0 = (NMV)MALLOC(nmv_adv*len);
7682: #if 0
7683: ndv_alloc += nmv_adv*len;
7684: #endif
7685: mr = mr0;
7686: p = s0vect;
7687: for ( j = k = 0; j < col; j++, p += nd_wpd )
7688: if ( !rhead[j] ) {
7689: c[0] = vect[k++][0];
7690: if ( mpz_sgn(c) ) {
7691: ndl_copy(p,DL(mr)); MPZTOZ(c,CZ(mr)); NMV_ADV(mr);
7692: }
7693: }
7694: MKNDV(nd_nvar,mr0,len,r);
7695: return r;
7696: }
7697: }
7698:
7699: /* for plain vector */
7700:
7701: NDV plain_vect_to_ndv_q(Z *vect,int col,UINT *s0vect)
7702: {
7703: int j,k,len;
7704: UINT *p;
7705: Z c;
7706: NDV r;
7707: NMV mr0,mr;
7708:
7709: for ( j = 0, len = 0; j < col; j++ ) if ( vect[j] ) len++;
7710: if ( !len ) return 0;
7711: else {
7712: mr0 = (NMV)MALLOC(nmv_adv*len);
7713: #if 0
7714: ndv_alloc += nmv_adv*len;
7715: #endif
7716: mr = mr0;
7717: p = s0vect;
7718: for ( j = k = 0; j < col; j++, p += nd_wpd, k++ )
7719: if ( (c = vect[k]) != 0 ) {
7720: if ( !INT(c) )
1.6 noro 7721: error("plain_vect_to_ndv_q : components must be integers");
7722: ndl_copy(p,DL(mr)); CZ(mr) = c; NMV_ADV(mr);
1.1 noro 7723: }
7724: MKNDV(nd_nvar,mr0,len,r);
7725: return r;
7726: }
7727: }
7728:
7729: int nd_sp_f4(int m,int trace,ND_pairs l,PGeoBucket bucket)
7730: {
7731: ND_pairs t;
7732: NODE sp0,sp;
7733: int stat;
7734: ND spol;
7735:
7736: for ( t = l; t; t = NEXT(t) ) {
7737: stat = nd_sp(m,trace,t,&spol);
7738: if ( !stat ) return 0;
7739: if ( spol ) {
7740: add_pbucket_symbolic(bucket,spol);
7741: }
7742: }
7743: return 1;
7744: }
7745:
7746: int nd_symbolic_preproc(PGeoBucket bucket,int trace,UINT **s0vect,NODE *r)
7747: {
7748: NODE rp0,rp;
7749: NM mul,head,s0,s;
7750: int index,col,i,sugar;
7751: RHist h;
7752: UINT *s0v,*p;
7753: NM_ind_pair pair;
7754: ND red;
7755: NDV *ps;
7756:
7757: s0 = 0; rp0 = 0; col = 0;
7758: if ( nd_demand )
7759: ps = trace?nd_ps_trace_sym:nd_ps_sym;
7760: else
7761: ps = trace?nd_ps_trace:nd_ps;
7762: while ( 1 ) {
7763: head = remove_head_pbucket_symbolic(bucket);
7764: if ( !head ) break;
7765: if ( !s0 ) s0 = head;
7766: else NEXT(s) = head;
7767: s = head;
7768: index = ndl_find_reducer(DL(head));
7769: if ( index >= 0 ) {
7770: h = nd_psh[index];
7771: NEWNM(mul);
7772: ndl_sub(DL(head),DL(h),DL(mul));
7773: if ( ndl_check_bound2(index,DL(mul)) )
7774: return 0;
7775: sugar = TD(DL(mul))+SG(ps[index]);
7776: MKNM_ind_pair(pair,mul,index,sugar);
7777: red = ndv_mul_nm_symbolic(mul,ps[index]);
7778: add_pbucket_symbolic(bucket,nd_remove_head(red));
7779: NEXTNODE(rp0,rp); BDY(rp) = (pointer)pair;
7780: }
7781: col++;
7782: }
7783: if ( rp0 ) NEXT(rp) = 0;
7784: NEXT(s) = 0;
7785: s0v = (UINT *)MALLOC_ATOMIC(col*nd_wpd*sizeof(UINT));
7786: for ( i = 0, p = s0v, s = s0; i < col;
7787: i++, p += nd_wpd, s = NEXT(s) ) ndl_copy(DL(s),p);
7788: *s0vect = s0v;
7789: *r = rp0;
7790: return col;
7791: }
7792:
7793: void print_ndp(ND_pairs l)
7794: {
7795: ND_pairs t;
7796:
7797: for ( t = l; t; t = NEXT(t) )
7798: printf("[%d,%d] ",t->i1,t->i2);
7799: printf("\n");
7800: }
7801:
7802: NODE nd_f4(int m,int checkonly,int **indp)
7803: {
7804: int i,nh,stat,index,f4red;
7805: NODE r,g,tn0,tn,node;
7806: ND_pairs d,l,t,ll0,ll,lh;
7807: LIST l0,l1;
7808: ND spol,red;
7809: NDV nf,redv;
7810: NM s0,s;
7811: NODE rp0,srp0,nflist,nzlist,nzlist_t;
7812: int nsp,nred,col,rank,len,k,j,a,i1s,i2s;
7813: UINT c;
7814: UINT **spmat;
7815: UINT *s0vect,*svect,*p,*v;
7816: int *colstat;
7817: IndArray *imat;
7818: int *rhead;
7819: int spcol,sprow;
7820: int sugar,sugarh;
7821: PGeoBucket bucket;
7822: struct oEGT eg0,eg1,eg_f4;
7823: Z i1,i2,sugarq;
1.12 noro 7824:
7825: init_eg(&f4_symb); init_eg(&f4_conv); init_eg(&f4_conv); init_eg(&f4_elim1); init_eg(&f4_elim2);
1.1 noro 7826: #if 0
7827: ndv_alloc = 0;
7828: #endif
1.11 noro 7829: Nf4_red=0;
1.1 noro 7830: g = 0; d = 0;
7831: for ( i = 0; i < nd_psn; i++ ) {
7832: d = update_pairs(d,g,i,0);
7833: g = update_base(g,i);
7834: }
7835: nzlist = 0;
7836: nzlist_t = nd_nzlist;
7837: f4red = 1;
7838: nd_last_nonzero = 0;
7839: while ( d ) {
7840: get_eg(&eg0);
7841: l = nd_minsugarp(d,&d);
7842: sugar = nd_sugarweight?l->sugar2:SG(l);
7843: if ( MaxDeg > 0 && sugar > MaxDeg ) break;
7844: if ( nzlist_t ) {
7845: node = BDY((LIST)BDY(nzlist_t));
1.6 noro 7846: sugarh = ZTOS((Q)ARG0(node));
1.1 noro 7847: tn = BDY((LIST)ARG1(node));
7848: if ( !tn ) {
7849: nzlist_t = NEXT(nzlist_t);
7850: continue;
7851: }
7852: /* tn = [[i1,i2],...] */
7853: lh = nd_ipairtospair(tn);
7854: }
7855: bucket = create_pbucket();
7856: stat = nd_sp_f4(m,0,l,bucket);
7857: if ( !stat ) {
7858: for ( t = l; NEXT(t); t = NEXT(t) );
7859: NEXT(t) = d; d = l;
7860: d = nd_reconstruct(0,d);
7861: continue;
7862: }
7863: if ( bucket->m < 0 ) continue;
7864: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
7865: if ( !col ) {
7866: for ( t = l; NEXT(t); t = NEXT(t) );
7867: NEXT(t) = d; d = l;
7868: d = nd_reconstruct(0,d);
7869: continue;
7870: }
1.12 noro 7871: get_eg(&eg1); init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg1); add_eg(&f4_symb,&eg0,&eg1);
1.1 noro 7872: if ( DP_Print )
1.6 noro 7873: fprintf(asir_out,"sugar=%d,symb=%.3fsec,",
1.5 noro 7874: sugar,eg_f4.exectime);
1.1 noro 7875: nflist = nd_f4_red(m,nd_nzlist?lh:l,0,s0vect,col,rp0,nd_gentrace?&ll:0);
7876: if ( checkonly && nflist ) return 0;
7877: /* adding new bases */
7878: if ( nflist ) nd_last_nonzero = f4red;
7879: for ( r = nflist; r; r = NEXT(r) ) {
7880: nf = (NDV)BDY(r);
7881: ndv_removecont(m,nf);
7882: if ( !m && nd_nalg ) {
7883: ND nf1;
7884:
7885: nf1 = ndvtond(m,nf);
7886: nd_monic(0,&nf1);
7887: nd_removecont(m,nf1);
7888: nf = ndtondv(m,nf1);
7889: }
1.24 noro 7890: nh = ndv_newps(m,nf,0);
1.1 noro 7891: d = update_pairs(d,g,nh,0);
7892: g = update_base(g,nh);
7893: }
7894: if ( DP_Print ) {
7895: fprintf(asir_out,"f4red=%d,gblen=%d\n",f4red,length(g)); fflush(asir_out);
7896: }
7897: if ( nd_gentrace ) {
7898: for ( t = ll, tn0 = 0; t; t = NEXT(t) ) {
7899: NEXTNODE(tn0,tn);
1.6 noro 7900: STOZ(t->i1,i1); STOZ(t->i2,i2);
1.1 noro 7901: node = mknode(2,i1,i2); MKLIST(l0,node);
7902: BDY(tn) = l0;
7903: }
7904: if ( tn0 ) NEXT(tn) = 0; MKLIST(l0,tn0);
1.6 noro 7905: STOZ(sugar,sugarq); node = mknode(2,sugarq,l0); MKLIST(l1,node);
1.1 noro 7906: MKNODE(node,l1,nzlist); nzlist = node;
7907: }
7908: if ( nd_nzlist ) nzlist_t = NEXT(nzlist_t);
7909: f4red++;
7910: if ( nd_f4red && f4red > nd_f4red ) break;
7911: if ( nd_rank0 && !nflist ) break;
7912: }
7913: if ( nd_gentrace ) {
7914: MKLIST(l0,reverse_node(nzlist));
7915: MKNODE(nd_alltracelist,l0,0);
7916: }
7917: #if 0
7918: fprintf(asir_out,"ndv_alloc=%d\n",ndv_alloc);
7919: #endif
1.12 noro 7920: if ( DP_Print ) {
7921: fprintf(asir_out,"number of red=%d,",Nf4_red);
7922: fprintf(asir_out,"symb=%.3fsec,conv=%.3fsec,elim1=%.3fsec,elim2=%.3fsec\n",
7923: f4_symb.exectime,f4_conv.exectime,f4_elim1.exectime,f4_elim2.exectime);
7924: }
1.1 noro 7925: conv_ilist(nd_demand,0,g,indp);
7926: return g;
7927: }
7928:
7929: NODE nd_f4_trace(int m,int **indp)
7930: {
7931: int i,nh,stat,index;
7932: NODE r,g;
7933: ND_pairs d,l,l0,t;
7934: ND spol,red;
7935: NDV nf,redv,nfqv,nfv;
7936: NM s0,s;
7937: NODE rp0,srp0,nflist;
7938: int nsp,nred,col,rank,len,k,j,a;
7939: UINT c;
7940: UINT **spmat;
7941: UINT *s0vect,*svect,*p,*v;
7942: int *colstat;
7943: IndArray *imat;
7944: int *rhead;
7945: int spcol,sprow;
7946: int sugar;
7947: PGeoBucket bucket;
7948: struct oEGT eg0,eg1,eg_f4;
7949:
7950: g = 0; d = 0;
7951: for ( i = 0; i < nd_psn; i++ ) {
7952: d = update_pairs(d,g,i,0);
7953: g = update_base(g,i);
7954: }
7955: while ( d ) {
7956: get_eg(&eg0);
7957: l = nd_minsugarp(d,&d);
7958: sugar = SG(l);
7959: if ( MaxDeg > 0 && sugar > MaxDeg ) break;
7960: bucket = create_pbucket();
7961: stat = nd_sp_f4(m,0,l,bucket);
7962: if ( !stat ) {
7963: for ( t = l; NEXT(t); t = NEXT(t) );
7964: NEXT(t) = d; d = l;
7965: d = nd_reconstruct(1,d);
7966: continue;
7967: }
7968: if ( bucket->m < 0 ) continue;
7969: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
7970: if ( !col ) {
7971: for ( t = l; NEXT(t); t = NEXT(t) );
7972: NEXT(t) = d; d = l;
7973: d = nd_reconstruct(1,d);
7974: continue;
7975: }
7976: get_eg(&eg1); init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg1);
7977: if ( DP_Print )
1.3 noro 7978: fprintf(asir_out,"\nsugar=%d,symb=%.3fsec,",
1.5 noro 7979: sugar,eg_f4.exectime);
1.1 noro 7980: nflist = nd_f4_red(m,l,0,s0vect,col,rp0,&l0);
7981: if ( !l0 ) continue;
7982: l = l0;
7983:
7984: /* over Q */
7985: bucket = create_pbucket();
7986: stat = nd_sp_f4(0,1,l,bucket);
7987: if ( !stat ) {
7988: for ( t = l; NEXT(t); t = NEXT(t) );
7989: NEXT(t) = d; d = l;
7990: d = nd_reconstruct(1,d);
7991: continue;
7992: }
7993: if ( bucket->m < 0 ) continue;
7994: col = nd_symbolic_preproc(bucket,1,&s0vect,&rp0);
7995: if ( !col ) {
7996: for ( t = l; NEXT(t); t = NEXT(t) );
7997: NEXT(t) = d; d = l;
7998: d = nd_reconstruct(1,d);
7999: continue;
8000: }
8001: nflist = nd_f4_red(0,l,1,s0vect,col,rp0,0);
8002: /* adding new bases */
8003: for ( r = nflist; r; r = NEXT(r) ) {
8004: nfqv = (NDV)BDY(r);
8005: ndv_removecont(0,nfqv);
1.6 noro 8006: if ( !remqi((Q)HCZ(nfqv),m) ) return 0;
1.1 noro 8007: if ( nd_nalg ) {
8008: ND nf1;
8009:
8010: nf1 = ndvtond(m,nfqv);
8011: nd_monic(0,&nf1);
8012: nd_removecont(0,nf1);
8013: nfqv = ndtondv(0,nf1); nd_free(nf1);
8014: }
8015: nfv = ndv_dup(0,nfqv);
8016: ndv_mod(m,nfv);
8017: ndv_removecont(m,nfv);
1.24 noro 8018: nh = ndv_newps(0,nfv,nfqv);
1.1 noro 8019: d = update_pairs(d,g,nh,0);
8020: g = update_base(g,nh);
8021: }
8022: }
8023: #if 0
8024: fprintf(asir_out,"ndv_alloc=%d\n",ndv_alloc);
8025: #endif
8026: conv_ilist(nd_demand,1,g,indp);
8027: return g;
8028: }
8029:
8030: int rref(matrix mat,int *sugar)
8031: {
8032: int row,col,i,j,k,l,s,wcol,wj;
8033: unsigned long bj;
8034: unsigned long **a;
8035: unsigned long *ai,*ak,*as,*t;
8036: int *pivot;
8037:
8038: row = mat->row;
8039: col = mat->col;
8040: a = mat->a;
8041: wcol = (col+BLEN-1)/BLEN;
8042: pivot = (int *)MALLOC_ATOMIC(row*sizeof(int));
8043: i = 0;
8044: for ( j = 0; j < col; j++ ) {
8045: wj = j/BLEN; bj = 1L<<(j%BLEN);
8046: for ( k = i; k < row; k++ )
8047: if ( a[k][wj] & bj ) break;
8048: if ( k == row ) continue;
8049: pivot[i] = j;
8050: if ( k != i ) {
8051: t = a[i]; a[i] = a[k]; a[k] = t;
8052: s = sugar[i]; sugar[i] = sugar[k]; sugar[k] = s;
8053: }
8054: ai = a[i];
8055: for ( k = i+1; k < row; k++ ) {
8056: ak = a[k];
8057: if ( ak[wj] & bj ) {
8058: for ( l = wj; l < wcol; l++ )
8059: ak[l] ^= ai[l];
8060: sugar[k] = MAX(sugar[k],sugar[i]);
8061: }
8062: }
8063: i++;
8064: }
8065: for ( k = i-1; k >= 0; k-- ) {
8066: j = pivot[k]; wj = j/BLEN; bj = 1L<<(j%BLEN);
8067: ak = a[k];
8068: for ( s = 0; s < k; s++ ) {
8069: as = a[s];
8070: if ( as[wj] & bj ) {
8071: for ( l = wj; l < wcol; l++ )
8072: as[l] ^= ak[l];
8073: sugar[s] = MAX(sugar[s],sugar[k]);
8074: }
8075: }
8076: }
8077: return i;
8078: }
8079:
8080: void print_matrix(matrix mat)
8081: {
8082: int row,col,i,j;
8083: unsigned long *ai;
8084:
8085: row = mat->row;
8086: col = mat->col;
8087: printf("%d x %d\n",row,col);
8088: for ( i = 0; i < row; i++ ) {
8089: ai = mat->a[i];
8090: for ( j = 0; j < col; j++ ) {
8091: if ( ai[j/BLEN] & (1L<<(j%BLEN)) ) putchar('1');
8092: else putchar('0');
8093: }
8094: putchar('\n');
8095: }
8096: }
8097:
8098: NDV vect_to_ndv_2(unsigned long *vect,int col,UINT *s0vect);
8099:
8100: void red_by_vect_2(matrix mat,int *sugar,unsigned long *v,int rhead,int rsugar)
8101: {
8102: int row,col,wcol,wj,i,j;
8103: unsigned long bj;
8104: unsigned long *ai;
8105: unsigned long **a;
8106: int len;
8107: int *pos;
8108:
8109: row = mat->row;
8110: col = mat->col;
8111: wcol = (col+BLEN-1)/BLEN;
8112: pos = (int *)MALLOC(wcol*sizeof(int));
8113: bzero(pos,wcol*sizeof(int));
8114: for ( i = j = 0; i < wcol; i++ )
8115: if ( v[i] ) pos[j++] = i;;
8116: len = j;
8117: wj = rhead/BLEN;
8118: bj = 1L<<rhead%BLEN;
8119: a = mat->a;
8120: for ( i = 0; i < row; i++ ) {
8121: ai = a[i];
8122: if ( ai[wj]&bj ) {
8123: for ( j = 0; j < len; j++ )
8124: ai[pos[j]] ^= v[pos[j]];
8125: sugar[i] = MAX(sugar[i],rsugar);
8126: }
8127: }
8128: }
8129:
8130: NODE nd_f4_red_2(ND_pairs sp0,UINT *s0vect,int col,NODE rp0,ND_pairs *nz)
8131: {
8132: int nsp,nred,i,i0,k,rank,row;
8133: NODE r0,rp;
8134: ND_pairs sp;
8135: ND spol;
8136: NM_ind_pair rt;
8137: int *s0hash;
8138: UINT *s;
8139: int *pivot,*sugar,*head;
8140: matrix mat;
8141: NM m;
8142: NODE r;
8143: struct oEGT eg0,eg1,eg2,eg_elim1,eg_elim2;
8144: int rhead,rsugar,size;
8145: unsigned long *v;
8146:
8147: get_eg(&eg0);
8148: for ( sp = sp0, nsp = 0; sp; sp = NEXT(sp), nsp++ );
8149: nred = length(rp0);
8150: mat = alloc_matrix(nsp,col);
8151: s0hash = (int *)MALLOC(col*sizeof(int));
8152: for ( i = 0, s = s0vect; i < col; i++, s += nd_wpd )
8153: s0hash[i] = ndl_hash_value(s);
8154:
8155: sugar = (int *)MALLOC(nsp*sizeof(int));
8156: for ( i = 0, sp = sp0; sp; sp = NEXT(sp) ) {
8157: nd_sp(2,0,sp,&spol);
8158: if ( spol ) {
8159: mat->a[i] = nd_to_vect_2(s0vect,col,s0hash,spol);
8160: sugar[i] = SG(spol);
8161: i++;
8162: }
8163: }
8164: mat->row = i;
8165: if ( DP_Print ) {
8166: fprintf(asir_out,"%dx%d,",mat->row,mat->col); fflush(asir_out);
8167: }
8168: size = ((col+BLEN-1)/BLEN)*sizeof(unsigned long);
8169: v = CALLOC((col+BLEN-1)/BLEN,sizeof(unsigned long));
8170: for ( rp = rp0, i = 0; rp; rp = NEXT(rp), i++ ) {
8171: rt = (NM_ind_pair)BDY(rp);
8172: bzero(v,size);
8173: rhead = nd_nm_to_vect_2(s0vect,col,s0hash,nd_ps[rt->index],rt->mul,v);
8174: rsugar = SG(nd_ps[rt->index])+TD(DL(rt->mul));
8175: red_by_vect_2(mat,sugar,v,rhead,rsugar);
8176: }
8177:
8178: get_eg(&eg1);
8179: init_eg(&eg_elim1); add_eg(&eg_elim1,&eg0,&eg1);
8180: rank = rref(mat,sugar);
8181:
8182: for ( i = 0, r0 = 0; i < rank; i++ ) {
8183: NEXTNODE(r0,r);
8184: BDY(r) = (pointer)vect_to_ndv_2(mat->a[i],col,s0vect);
8185: SG((NDV)BDY(r)) = sugar[i];
8186: }
8187: if ( r0 ) NEXT(r) = 0;
8188: get_eg(&eg2);
8189: init_eg(&eg_elim2); add_eg(&eg_elim2,&eg1,&eg2);
8190: if ( DP_Print ) {
8191: fprintf(asir_out,"elim1=%.3fsec,elim2=%.3fsec,",
1.5 noro 8192: eg_elim1.exectime,eg_elim2.exectime);
1.1 noro 8193: fflush(asir_out);
8194: }
8195: return r0;
8196: }
8197:
8198:
8199: NODE nd_f4_red(int m,ND_pairs sp0,int trace,UINT *s0vect,int col,NODE rp0,ND_pairs *nz)
8200: {
8201: IndArray *imat;
1.11 noro 8202: int nsp,nred,i,start;
1.1 noro 8203: int *rhead;
8204: NODE r0,rp;
8205: ND_pairs sp;
8206: NM_ind_pair *rvect;
8207: UINT *s;
8208: int *s0hash;
1.11 noro 8209: struct oEGT eg0,eg1,eg_conv;
1.1 noro 8210:
8211: if ( m == 2 && nd_rref2 )
8212: return nd_f4_red_2(sp0,s0vect,col,rp0,nz);
8213:
8214: for ( sp = sp0, nsp = 0; sp; sp = NEXT(sp), nsp++ );
8215: nred = length(rp0);
8216: imat = (IndArray *)MALLOC(nred*sizeof(IndArray));
8217: rhead = (int *)MALLOC(col*sizeof(int));
8218: for ( i = 0; i < col; i++ ) rhead[i] = 0;
8219:
8220: /* construction of index arrays */
1.11 noro 8221: get_eg(&eg0);
1.1 noro 8222: if ( DP_Print ) {
1.11 noro 8223: fprintf(asir_out,"%dx%d,",nsp+nred,col);
8224: fflush(asir_out);
1.1 noro 8225: }
8226: rvect = (NM_ind_pair *)MALLOC(nred*sizeof(NM_ind_pair));
1.11 noro 8227: for ( start = 0, rp = rp0, i = 0; rp; i++, rp = NEXT(rp) ) {
1.1 noro 8228: rvect[i] = (NM_ind_pair)BDY(rp);
1.11 noro 8229: imat[i] = nm_ind_pair_to_vect_compress(trace,s0vect,col,rvect[i],start);
1.1 noro 8230: rhead[imat[i]->head] = 1;
1.11 noro 8231: start = imat[i]->head;
8232: }
1.12 noro 8233: get_eg(&eg1); init_eg(&eg_conv); add_eg(&eg_conv,&eg0,&eg1); add_eg(&f4_conv,&eg0,&eg1);
1.11 noro 8234: if ( DP_Print ) {
8235: fprintf(asir_out,"conv=%.3fsec,",eg_conv.exectime);
8236: fflush(asir_out);
1.1 noro 8237: }
8238: if ( m > 0 )
1.7 noro 8239: #if SIZEOF_LONG==8
1.1 noro 8240: r0 = nd_f4_red_mod64_main(m,sp0,nsp,s0vect,col,rvect,rhead,imat,nred,nz);
8241: #else
8242: r0 = nd_f4_red_main(m,sp0,nsp,s0vect,col,rvect,rhead,imat,nred,nz);
8243: #endif
8244: else if ( m == -1 )
8245: r0 = nd_f4_red_sf_main(m,sp0,nsp,s0vect,col,rvect,rhead,imat,nred,nz);
8246: else if ( m == -2 )
8247: r0 = nd_f4_red_lf_main(m,sp0,nsp,trace,s0vect,col,rvect,rhead,imat,nred);
8248: else
8249: r0 = nd_f4_red_q_main(sp0,nsp,trace,s0vect,col,rvect,rhead,imat,nred);
8250: return r0;
8251: }
8252:
8253: /* for Fp, 2<=p<2^16 */
8254:
8255: NODE nd_f4_red_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
8256: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz)
8257: {
8258: int spcol,sprow,a;
8259: int i,j,k,l,rank;
8260: NODE r0,r;
8261: ND_pairs sp;
8262: ND spol;
8263: UINT **spmat;
8264: UINT *svect,*v;
8265: int *colstat;
8266: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
8267: int maxrs;
8268: int *spsugar;
8269: ND_pairs *spactive;
8270:
8271: spcol = col-nred;
8272: get_eg(&eg0);
8273: /* elimination (1st step) */
8274: spmat = (UINT **)MALLOC(nsp*sizeof(UINT *));
8275: svect = (UINT *)MALLOC(col*sizeof(UINT));
8276: spsugar = (int *)MALLOC(nsp*sizeof(int));
8277: spactive = !nz?0:(ND_pairs *)MALLOC(nsp*sizeof(ND_pairs));
8278: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
8279: nd_sp(m,0,sp,&spol);
8280: if ( !spol ) continue;
8281: nd_to_vect(m,s0vect,col,spol,svect);
8282: if ( m == -1 )
8283: maxrs = ndv_reduce_vect_sf(m,svect,col,imat,rvect,nred);
8284: else
8285: maxrs = ndv_reduce_vect(m,svect,col,imat,rvect,nred);
8286: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
8287: if ( i < col ) {
8288: spmat[sprow] = v = (UINT *)MALLOC_ATOMIC(spcol*sizeof(UINT));
8289: for ( j = k = 0; j < col; j++ )
8290: if ( !rhead[j] ) v[k++] = svect[j];
8291: spsugar[sprow] = MAX(maxrs,SG(spol));
8292: if ( nz )
8293: spactive[sprow] = sp;
8294: sprow++;
8295: }
8296: nd_free(spol);
8297: }
8298: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
8299: if ( DP_Print ) {
1.5 noro 8300: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 8301: fflush(asir_out);
8302: }
8303: /* free index arrays */
8304: for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c);
8305:
8306: /* elimination (2nd step) */
8307: colstat = (int *)MALLOC(spcol*sizeof(int));
8308: if ( m == -1 )
8309: rank = nd_gauss_elim_sf(spmat,spsugar,sprow,spcol,m,colstat);
8310: else
8311: rank = nd_gauss_elim_mod(spmat,spsugar,spactive,sprow,spcol,m,colstat);
8312: r0 = 0;
8313: for ( i = 0; i < rank; i++ ) {
8314: NEXTNODE(r0,r); BDY(r) =
8315: (pointer)vect_to_ndv(spmat[i],spcol,col,rhead,s0vect);
8316: SG((NDV)BDY(r)) = spsugar[i];
8317: GCFREE(spmat[i]);
8318: }
8319: if ( r0 ) NEXT(r) = 0;
8320:
8321: for ( ; i < sprow; i++ ) GCFREE(spmat[i]);
8322: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
8323: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
8324: if ( DP_Print ) {
1.5 noro 8325: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 8326: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
8327: nsp,nred,sprow,spcol,rank);
1.5 noro 8328: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 8329: }
8330: if ( nz ) {
8331: for ( i = 0; i < rank-1; i++ ) NEXT(spactive[i]) = spactive[i+1];
8332: if ( rank > 0 ) {
8333: NEXT(spactive[rank-1]) = 0;
8334: *nz = spactive[0];
8335: } else
8336: *nz = 0;
8337: }
8338: return r0;
8339: }
8340:
8341:
8342: /* for small finite fields */
8343:
8344: NODE nd_f4_red_sf_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
8345: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz)
8346: {
8347: int spcol,sprow,a;
8348: int i,j,k,l,rank;
8349: NODE r0,r;
8350: ND_pairs sp;
8351: ND spol;
8352: UINT **spmat;
8353: UINT *svect,*v;
8354: int *colstat;
8355: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
8356: int maxrs;
8357: int *spsugar;
8358: ND_pairs *spactive;
8359:
8360: spcol = col-nred;
8361: get_eg(&eg0);
8362: /* elimination (1st step) */
8363: spmat = (UINT **)MALLOC(nsp*sizeof(UINT *));
8364: svect = (UINT *)MALLOC(col*sizeof(UINT));
8365: spsugar = (int *)MALLOC(nsp*sizeof(int));
8366: spactive = !nz?0:(ND_pairs *)MALLOC(nsp*sizeof(ND_pairs));
8367: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
8368: nd_sp(m,0,sp,&spol);
8369: if ( !spol ) continue;
8370: nd_to_vect(m,s0vect,col,spol,svect);
8371: maxrs = ndv_reduce_vect_sf(m,svect,col,imat,rvect,nred);
8372: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
8373: if ( i < col ) {
8374: spmat[sprow] = v = (UINT *)MALLOC_ATOMIC(spcol*sizeof(UINT));
8375: for ( j = k = 0; j < col; j++ )
8376: if ( !rhead[j] ) v[k++] = svect[j];
8377: spsugar[sprow] = MAX(maxrs,SG(spol));
8378: if ( nz )
8379: spactive[sprow] = sp;
8380: sprow++;
8381: }
8382: nd_free(spol);
8383: }
8384: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
8385: if ( DP_Print ) {
1.5 noro 8386: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 8387: fflush(asir_out);
8388: }
8389: /* free index arrays */
8390: for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c);
8391:
8392: /* elimination (2nd step) */
8393: colstat = (int *)MALLOC(spcol*sizeof(int));
8394: rank = nd_gauss_elim_sf(spmat,spsugar,sprow,spcol,m,colstat);
8395: r0 = 0;
8396: for ( i = 0; i < rank; i++ ) {
8397: NEXTNODE(r0,r); BDY(r) =
8398: (pointer)vect_to_ndv(spmat[i],spcol,col,rhead,s0vect);
8399: SG((NDV)BDY(r)) = spsugar[i];
8400: GCFREE(spmat[i]);
8401: }
8402: if ( r0 ) NEXT(r) = 0;
8403:
8404: for ( ; i < sprow; i++ ) GCFREE(spmat[i]);
8405: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
8406: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
8407: if ( DP_Print ) {
1.5 noro 8408: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 8409: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
8410: nsp,nred,sprow,spcol,rank);
1.5 noro 8411: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 8412: }
8413: if ( nz ) {
8414: for ( i = 0; i < rank-1; i++ ) NEXT(spactive[i]) = spactive[i+1];
8415: if ( rank > 0 ) {
8416: NEXT(spactive[rank-1]) = 0;
8417: *nz = spactive[0];
8418: } else
8419: *nz = 0;
8420: }
8421: return r0;
8422: }
8423:
8424: NODE nd_f4_red_lf_main(int m,ND_pairs sp0,int nsp,int trace,UINT *s0vect,int col,
8425: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred)
8426: {
8427: int spcol,sprow,a;
8428: int i,j,k,l,rank;
8429: NODE r0,r;
8430: ND_pairs sp;
8431: ND spol;
8432: mpz_t **spmat;
8433: mpz_t *svect,*v;
8434: int *colstat;
8435: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
8436: int maxrs;
8437: int *spsugar;
8438: pointer *w;
8439:
8440: spcol = col-nred;
8441: get_eg(&eg0);
8442: /* elimination (1st step) */
8443: spmat = (mpz_t **)MALLOC(nsp*sizeof(mpz_t *));
8444: svect = (mpz_t *)MALLOC(col*sizeof(mpz_t));
8445: spsugar = (int *)MALLOC(nsp*sizeof(int));
8446: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
8447: nd_sp(m,trace,sp,&spol);
8448: if ( !spol ) continue;
8449: nd_to_vect_lf(s0vect,col,spol,svect);
8450: maxrs = ndv_reduce_vect_lf(svect,trace,col,imat,rvect,nred);
8451: for ( i = 0; i < col; i++ ) if ( mpz_sgn(svect[i]) ) break;
8452: if ( i < col ) {
8453: spmat[sprow] = v = (mpz_t *)MALLOC(spcol*sizeof(mpz_t));
8454: for ( j = k = 0; j < col; j++ )
8455: if ( !rhead[j] ) v[k++][0] = svect[j][0];
8456: spsugar[sprow] = MAX(maxrs,SG(spol));
8457: sprow++;
8458: }
8459: /* nd_free(spol); */
8460: }
8461: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
8462: if ( DP_Print ) {
1.5 noro 8463: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 8464: fflush(asir_out);
8465: }
8466: /* free index arrays */
8467: /* for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c); */
8468:
8469: /* elimination (2nd step) */
8470: colstat = (int *)MALLOC(spcol*sizeof(int));
8471: rank = nd_gauss_elim_lf(spmat,spsugar,sprow,spcol,colstat);
8472: w = (pointer *)MALLOC(rank*sizeof(pointer));
8473: for ( i = 0; i < rank; i++ ) {
8474: #if 0
8475: w[rank-i-1] = (pointer)vect_to_ndv_lf(spmat[i],spcol,col,rhead,s0vect);
8476: SG((NDV)w[rank-i-1]) = spsugar[i];
8477: #else
8478: w[i] = (pointer)vect_to_ndv_lf(spmat[i],spcol,col,rhead,s0vect);
8479: SG((NDV)w[i]) = spsugar[i];
8480: #endif
8481: /* GCFREE(spmat[i]); */
8482:
8483: }
8484: #if 0
8485: qsort(w,rank,sizeof(NDV),
8486: (int (*)(const void *,const void *))ndv_compare);
8487: #endif
8488: r0 = 0;
8489: for ( i = 0; i < rank; i++ ) {
8490: NEXTNODE(r0,r); BDY(r) = w[i];
8491: }
8492: if ( r0 ) NEXT(r) = 0;
8493:
8494: /* for ( ; i < sprow; i++ ) GCFREE(spmat[i]); */
8495: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
8496: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
8497: if ( DP_Print ) {
1.5 noro 8498: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 8499: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
8500: nsp,nred,sprow,spcol,rank);
1.5 noro 8501: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 8502: }
8503: return r0;
8504: }
8505:
8506: NODE nd_f4_red_q_main(ND_pairs sp0,int nsp,int trace,UINT *s0vect,int col,
8507: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred)
8508: {
8509: int spcol,sprow,a;
8510: int i,j,k,l,rank;
8511: NODE r0,r;
8512: ND_pairs sp;
8513: ND spol;
8514: Z **spmat;
8515: Z *svect,*v;
8516: int *colstat;
8517: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
8518: int maxrs;
8519: int *spsugar;
8520: pointer *w;
8521:
8522: spcol = col-nred;
8523: get_eg(&eg0);
8524: /* elimination (1st step) */
8525: spmat = (Z **)MALLOC(nsp*sizeof(Q *));
8526: svect = (Z *)MALLOC(col*sizeof(Q));
8527: spsugar = (int *)MALLOC(nsp*sizeof(int));
8528: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
8529: nd_sp(0,trace,sp,&spol);
8530: if ( !spol ) continue;
8531: nd_to_vect_q(s0vect,col,spol,svect);
8532: maxrs = ndv_reduce_vect_q(svect,trace,col,imat,rvect,nred);
8533: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
8534: if ( i < col ) {
8535: spmat[sprow] = v = (Z *)MALLOC(spcol*sizeof(Q));
8536: for ( j = k = 0; j < col; j++ )
8537: if ( !rhead[j] ) v[k++] = svect[j];
8538: spsugar[sprow] = MAX(maxrs,SG(spol));
8539: sprow++;
8540: }
8541: /* nd_free(spol); */
8542: }
8543: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1);
8544: if ( DP_Print ) {
1.5 noro 8545: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
1.1 noro 8546: fflush(asir_out);
8547: }
8548: /* free index arrays */
8549: /* for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c); */
8550:
8551: /* elimination (2nd step) */
8552: colstat = (int *)MALLOC(spcol*sizeof(int));
8553: rank = nd_gauss_elim_q(spmat,spsugar,sprow,spcol,colstat);
8554: w = (pointer *)MALLOC(rank*sizeof(pointer));
8555: for ( i = 0; i < rank; i++ ) {
8556: #if 0
8557: w[rank-i-1] = (pointer)vect_to_ndv_q(spmat[i],spcol,col,rhead,s0vect);
8558: SG((NDV)w[rank-i-1]) = spsugar[i];
8559: #else
8560: w[i] = (pointer)vect_to_ndv_q(spmat[i],spcol,col,rhead,s0vect);
8561: SG((NDV)w[i]) = spsugar[i];
8562: #endif
8563: /* GCFREE(spmat[i]); */
8564: }
8565: #if 0
8566: qsort(w,rank,sizeof(NDV),
8567: (int (*)(const void *,const void *))ndv_compare);
8568: #endif
8569: r0 = 0;
8570: for ( i = 0; i < rank; i++ ) {
8571: NEXTNODE(r0,r); BDY(r) = w[i];
8572: }
8573: if ( r0 ) NEXT(r) = 0;
8574:
8575: /* for ( ; i < sprow; i++ ) GCFREE(spmat[i]); */
8576: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2);
8577: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
8578: if ( DP_Print ) {
1.5 noro 8579: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
1.1 noro 8580: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
8581: nsp,nred,sprow,spcol,rank);
1.5 noro 8582: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
1.1 noro 8583: }
8584: return r0;
8585: }
8586:
8587: FILE *nd_write,*nd_read;
8588:
8589: void nd_send_int(int a) {
8590: write_int(nd_write,(unsigned int *)&a);
8591: }
8592:
8593: void nd_send_intarray(int *p,int len) {
8594: write_intarray(nd_write,(unsigned int *)p,len);
8595: }
8596:
8597: int nd_recv_int() {
8598: int a;
8599:
8600: read_int(nd_read,(unsigned int *)&a);
8601: return a;
8602: }
8603:
8604: void nd_recv_intarray(int *p,int len) {
8605: read_intarray(nd_read,(unsigned int *)p,len);
8606: }
8607:
8608: void nd_send_ndv(NDV p) {
8609: int len,i;
8610: NMV m;
8611:
8612: if ( !p ) nd_send_int(0);
8613: else {
8614: len = LEN(p);
8615: nd_send_int(len);
8616: m = BDY(p);
8617: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
8618: nd_send_int(CM(m));
8619: nd_send_intarray((int *)DL(m),nd_wpd);
8620: }
8621: }
8622: }
8623:
8624: void nd_send_nd(ND p) {
8625: int len,i;
8626: NM m;
8627:
8628: if ( !p ) nd_send_int(0);
8629: else {
8630: len = LEN(p);
8631: nd_send_int(len);
8632: m = BDY(p);
8633: for ( i = 0; i < len; i++, m = NEXT(m) ) {
8634: nd_send_int(CM(m));
8635: nd_send_intarray((int *)DL(m),nd_wpd);
8636: }
8637: }
8638: }
8639:
8640: NDV nd_recv_ndv()
8641: {
8642: int len,i;
8643: NMV m,m0;
8644: NDV r;
8645:
8646: len = nd_recv_int();
8647: if ( !len ) return 0;
8648: else {
8649: m0 = m = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
8650: #if 0
8651: ndv_alloc += len*nmv_adv;
8652: #endif
8653: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
8654: CM(m) = nd_recv_int();
8655: nd_recv_intarray((int *)DL(m),nd_wpd);
8656: }
8657: MKNDV(nd_nvar,m0,len,r);
8658: return r;
8659: }
8660: }
8661:
8662: int nd_gauss_elim_q(Z **mat0,int *sugar,int row,int col,int *colstat)
8663: {
8664: int i,j,t,c,rank,inv;
8665: int *ci,*ri;
8666: Z dn;
8667: MAT m,nm;
8668:
8669: NEWMAT(m); m->row = row; m->col = col; m->body = (pointer **)mat0;
8670: rank = generic_gauss_elim(m,&nm,&dn,&ri,&ci);
8671: for ( i = 0; i < row; i++ )
8672: for ( j = 0; j < col; j++ )
8673: mat0[i][j] = 0;
8674: c = col-rank;
8675: for ( i = 0; i < rank; i++ ) {
8676: mat0[i][ri[i]] = dn;
8677: for ( j = 0; j < c; j++ )
8678: mat0[i][ci[j]] = (Z)BDY(nm)[i][j];
8679: }
8680: return rank;
8681: }
8682:
8683: int nd_gauss_elim_mod(UINT **mat0,int *sugar,ND_pairs *spactive,int row,int col,int md,int *colstat)
8684: {
8685: int i,j,k,l,inv,a,rank,s;
8686: unsigned int *t,*pivot,*pk;
8687: unsigned int **mat;
8688: ND_pairs pair;
8689:
8690: mat = (unsigned int **)mat0;
8691: for ( rank = 0, j = 0; j < col; j++ ) {
8692: for ( i = rank; i < row; i++ )
8693: mat[i][j] %= md;
8694: for ( i = rank; i < row; i++ )
8695: if ( mat[i][j] )
8696: break;
8697: if ( i == row ) {
8698: colstat[j] = 0;
8699: continue;
8700: } else
8701: colstat[j] = 1;
8702: if ( i != rank ) {
8703: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
8704: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
8705: if ( spactive ) {
8706: pair = spactive[i]; spactive[i] = spactive[rank];
8707: spactive[rank] = pair;
8708: }
8709: }
8710: pivot = mat[rank];
8711: s = sugar[rank];
8712: inv = invm(pivot[j],md);
8713: for ( k = j, pk = pivot+k; k < col; k++, pk++ )
8714: if ( *pk ) {
8715: if ( *pk >= (unsigned int)md )
8716: *pk %= md;
8717: DMAR(*pk,inv,0,md,*pk)
8718: }
8719: for ( i = rank+1; i < row; i++ ) {
8720: t = mat[i];
8721: if ( (a = t[j]) != 0 ) {
8722: sugar[i] = MAX(sugar[i],s);
8723: red_by_vect(md,t+j,pivot+j,md-a,col-j);
8724: }
8725: }
8726: rank++;
8727: }
8728: for ( j = col-1, l = rank-1; j >= 0; j-- )
8729: if ( colstat[j] ) {
8730: pivot = mat[l];
8731: s = sugar[l];
8732: for ( i = 0; i < l; i++ ) {
8733: t = mat[i];
8734: t[j] %= md;
8735: if ( (a = t[j]) != 0 ) {
8736: sugar[i] = MAX(sugar[i],s);
8737: red_by_vect(md,t+j,pivot+j,md-a,col-j);
8738: }
8739: }
8740: l--;
8741: }
8742: for ( j = 0, l = 0; l < rank; j++ )
8743: if ( colstat[j] ) {
8744: t = mat[l];
8745: for ( k = j; k < col; k++ )
8746: if ( t[k] >= (unsigned int)md )
8747: t[k] %= md;
8748: l++;
8749: }
8750: return rank;
8751: }
8752:
8753:
1.7 noro 8754: int nd_gauss_elim_sf(UINT **mat0,int *sugar,int row,int col,int md,int *colstat)
1.1 noro 8755: {
1.7 noro 8756: int i,j,k,l,inv,a,rank,s;
8757: unsigned int *t,*pivot,*pk;
8758: unsigned int **mat;
8759:
8760: mat = (unsigned int **)mat0;
8761: for ( rank = 0, j = 0; j < col; j++ ) {
8762: for ( i = rank; i < row; i++ )
8763: if ( mat[i][j] )
8764: break;
8765: if ( i == row ) {
8766: colstat[j] = 0;
8767: continue;
8768: } else
8769: colstat[j] = 1;
8770: if ( i != rank ) {
8771: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
8772: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
8773: }
8774: pivot = mat[rank];
8775: s = sugar[rank];
8776: inv = _invsf(pivot[j]);
8777: for ( k = j, pk = pivot+k; k < col; k++, pk++ )
8778: if ( *pk )
8779: *pk = _mulsf(*pk,inv);
8780: for ( i = rank+1; i < row; i++ ) {
8781: t = mat[i];
8782: if ( (a = t[j]) != 0 ) {
8783: sugar[i] = MAX(sugar[i],s);
8784: red_by_vect_sf(md,t+j,pivot+j,_chsgnsf(a),col-j);
8785: }
8786: }
8787: rank++;
8788: }
8789: for ( j = col-1, l = rank-1; j >= 0; j-- )
8790: if ( colstat[j] ) {
8791: pivot = mat[l];
8792: s = sugar[l];
8793: for ( i = 0; i < l; i++ ) {
8794: t = mat[i];
8795: if ( (a = t[j]) != 0 ) {
8796: sugar[i] = MAX(sugar[i],s);
8797: red_by_vect_sf(md,t+j,pivot+j,_chsgnsf(a),col-j);
8798: }
8799: }
8800: l--;
8801: }
8802: return rank;
8803: }
1.1 noro 8804:
1.7 noro 8805: int ndv_ishomo(NDV p)
8806: {
8807: NMV m;
8808: int len,h;
1.1 noro 8809:
8810: if ( !p ) return 1;
8811: len = LEN(p);
8812: m = BDY(p);
8813: h = TD(DL(m));
8814: NMV_ADV(m);
8815: for ( len--; len; len--, NMV_ADV(m) )
1.20 noro 8816: if ( TD(DL(m)) != h ) {
8817: return 0;
8818: }
1.1 noro 8819: return 1;
8820: }
8821:
8822: void ndv_save(NDV p,int index)
8823: {
8824: FILE *s;
8825: char name[BUFSIZ];
8826: short id;
8827: int nv,sugar,len,n,i,td,e,j;
8828: NMV m;
8829: unsigned int *dl;
8830: int mpos;
8831:
8832: sprintf(name,"%s/%d",Demand,index);
8833: s = fopen(name,"w");
8834: savevl(s,0);
8835: if ( !p ) {
8836: saveobj(s,0);
8837: return;
8838: }
8839: id = O_DP;
8840: nv = NV(p);
8841: sugar = SG(p);
8842: len = LEN(p);
8843: write_short(s,(unsigned short *)&id); write_int(s,(unsigned int *)&nv); write_int(s,(unsigned int *)&sugar);
8844: write_int(s,(unsigned int *)&len);
8845:
8846: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
1.6 noro 8847: saveobj(s,(Obj)CZ(m));
1.1 noro 8848: dl = DL(m);
8849: td = TD(dl);
8850: write_int(s,(unsigned int *)&td);
8851: for ( j = 0; j < nv; j++ ) {
8852: e = GET_EXP(dl,j);
8853: write_int(s,(unsigned int *)&e);
8854: }
8855: if ( nd_module ) {
8856: mpos = MPOS(dl); write_int(s,(unsigned int *)&mpos);
8857: }
8858: }
8859: fclose(s);
8860: }
8861:
8862: void nd_save_mod(ND p,int index)
8863: {
8864: FILE *s;
8865: char name[BUFSIZ];
8866: int nv,sugar,len,c;
8867: NM m;
8868:
8869: sprintf(name,"%s/%d",Demand,index);
8870: s = fopen(name,"w");
8871: if ( !p ) {
8872: len = 0;
8873: write_int(s,(unsigned int *)&len);
8874: fclose(s);
8875: return;
8876: }
8877: nv = NV(p);
8878: sugar = SG(p);
8879: len = LEN(p);
8880: write_int(s,(unsigned int *)&nv); write_int(s,(unsigned int *)&sugar); write_int(s,(unsigned int *)&len);
8881: for ( m = BDY(p); m; m = NEXT(m) ) {
8882: c = CM(m); write_int(s,(unsigned int *)&c);
8883: write_intarray(s,(unsigned int *)DL(m),nd_wpd);
8884: }
8885: fclose(s);
8886: }
8887:
8888: NDV ndv_load(int index)
8889: {
8890: FILE *s;
8891: char name[BUFSIZ];
8892: short id;
8893: int nv,sugar,len,n,i,td,e,j;
8894: NDV d;
8895: NMV m0,m;
8896: unsigned int *dl;
8897: Obj obj;
8898: int mpos;
8899:
8900: sprintf(name,"%s/%d",Demand,index);
8901: s = fopen(name,"r");
8902: if ( !s ) return 0;
8903:
8904: skipvl(s);
8905: read_short(s,(unsigned short *)&id);
8906: if ( !id ) return 0;
8907: read_int(s,(unsigned int *)&nv);
8908: read_int(s,(unsigned int *)&sugar);
8909: read_int(s,(unsigned int *)&len);
8910:
8911: m0 = m = MALLOC(len*nmv_adv);
8912: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
1.6 noro 8913: loadobj(s,&obj); CZ(m) = (Z)obj;
1.1 noro 8914: dl = DL(m);
8915: ndl_zero(dl);
8916: read_int(s,(unsigned int *)&td); TD(dl) = td;
8917: for ( j = 0; j < nv; j++ ) {
8918: read_int(s,(unsigned int *)&e);
8919: PUT_EXP(dl,j,e);
8920: }
8921: if ( nd_module ) {
8922: read_int(s,(unsigned int *)&mpos); MPOS(dl) = mpos;
8923: }
8924: if ( nd_blockmask ) ndl_weight_mask(dl);
8925: }
8926: fclose(s);
8927: MKNDV(nv,m0,len,d);
8928: SG(d) = sugar;
8929: return d;
8930: }
8931:
8932: ND nd_load_mod(int index)
8933: {
8934: FILE *s;
8935: char name[BUFSIZ];
8936: int nv,sugar,len,i,c;
8937: ND d;
8938: NM m0,m;
8939:
8940: sprintf(name,"%s/%d",Demand,index);
8941: s = fopen(name,"r");
8942: /* if the file does not exist, it means p[index]=0 */
8943: if ( !s ) return 0;
8944:
8945: read_int(s,(unsigned int *)&nv);
8946: if ( !nv ) { fclose(s); return 0; }
8947:
8948: read_int(s,(unsigned int *)&sugar);
8949: read_int(s,(unsigned int *)&len);
8950: for ( m0 = 0, i = 0; i < len; i++ ) {
8951: NEXTNM(m0,m);
8952: read_int(s,(unsigned int *)&c); CM(m) = c;
8953: read_intarray(s,(unsigned int *)DL(m),nd_wpd);
8954: }
8955: NEXT(m) = 0;
8956: MKND(nv,m0,len,d);
8957: SG(d) = sugar;
8958: fclose(s);
8959: return d;
8960: }
8961:
8962: void nd_det(int mod,MAT f,P *rp)
8963: {
8964: VL fv,tv;
8965: int n,i,j,max,e,nvar,sgn,k0,l0,len0,len,k,l,a;
8966: pointer **m;
8967: P **w;
8968: P mp,r;
8969: NDV **dm;
8970: NDV *t,*mi,*mj;
8971: NDV d,s,mij,mjj;
8972: ND u;
8973: NMV nmv;
8974: UINT *bound;
8975: PGeoBucket bucket;
8976: struct order_spec *ord;
8977: Z dq,dt,ds;
8978: Z mone;
8979: Z gn,qn,dn0,nm,dn;
8980:
8981: create_order_spec(0,0,&ord);
8982: nd_init_ord(ord);
8983: get_vars((Obj)f,&fv);
8984: if ( f->row != f->col )
8985: error("nd_det : non-square matrix");
8986: n = f->row;
8987: m = f->body;
8988: for ( nvar = 0, tv = fv; tv; tv = NEXT(tv), nvar++ );
8989:
8990: if ( !nvar ) {
8991: if ( !mod )
8992: detp(CO,(P **)m,n,rp);
8993: else {
8994: w = (P **)almat_pointer(n,n);
8995: for ( i = 0; i < n; i++ )
8996: for ( j = 0; j < n; j++ )
8997: ptomp(mod,(P)m[i][j],&w[i][j]);
8998: detmp(CO,mod,w,n,&mp);
8999: mptop(mp,rp);
9000: }
9001: return;
9002: }
9003:
9004: if ( !mod ) {
9005: w = (P **)almat_pointer(n,n);
9006: dq = ONE;
9007: for ( i = 0; i < n; i++ ) {
9008: dn0 = ONE;
9009: for ( j = 0; j < n; j++ ) {
9010: if ( !m[i][j] ) continue;
9011: lgp(m[i][j],&nm,&dn);
1.6 noro 9012: gcdz(dn0,dn,&gn); divsz(dn0,gn,&qn); mulz(qn,dn,&dn0);
1.1 noro 9013: }
9014: if ( !UNIZ(dn0) ) {
9015: ds = dn0;
9016: for ( j = 0; j < n; j++ )
9017: mulp(CO,(P)m[i][j],(P)ds,&w[i][j]);
9018: mulz(dq,ds,&dt); dq = dt;
9019: } else
9020: for ( j = 0; j < n; j++ )
9021: w[i][j] = (P)m[i][j];
9022: }
9023: m = (pointer **)w;
9024: }
9025:
9026: for ( i = 0, max = 1; i < n; i++ )
9027: for ( j = 0; j < n; j++ )
9028: for ( tv = fv; tv; tv = NEXT(tv) ) {
9029: e = getdeg(tv->v,(P)m[i][j]);
9030: max = MAX(e,max);
9031: }
9032: nd_setup_parameters(nvar,max);
9033: dm = (NDV **)almat_pointer(n,n);
9034: for ( i = 0, max = 1; i < n; i++ )
9035: for ( j = 0; j < n; j++ ) {
9036: dm[i][j] = ptondv(CO,fv,m[i][j]);
9037: if ( mod ) ndv_mod(mod,dm[i][j]);
9038: if ( dm[i][j] && !LEN(dm[i][j]) ) dm[i][j] = 0;
9039: }
9040: d = ptondv(CO,fv,(P)ONE);
9041: if ( mod ) ndv_mod(mod,d);
9042: chsgnz(ONE,&mone);
9043: for ( j = 0, sgn = 1; j < n; j++ ) {
9044: if ( DP_Print ) {
9045: fprintf(asir_out,".");
9046: }
9047: for ( i = j; i < n && !dm[i][j]; i++ );
9048: if ( i == n ) {
9049: *rp = 0;
9050: return;
9051: }
9052: k0 = i; l0 = j; len0 = LEN(dm[k0][l0]);
9053: for ( k = j; k < n; k++ )
9054: for ( l = j; l < n; l++ )
9055: if ( dm[k][l] && LEN(dm[k][l]) < len0 ) {
9056: k0 = k; l0 = l; len0 = LEN(dm[k][l]);
9057: }
9058: if ( k0 != j ) {
9059: t = dm[j]; dm[j] = dm[k0]; dm[k0] = t;
9060: sgn = -sgn;
9061: }
9062: if ( l0 != j ) {
9063: for ( k = j; k < n; k++ ) {
9064: s = dm[k][j]; dm[k][j] = dm[k][l0]; dm[k][l0] = s;
9065: }
9066: sgn = -sgn;
9067: }
9068: bound = nd_det_compute_bound(dm,n,j);
9069: for ( k = 0; k < nd_nvar; k++ )
9070: if ( bound[k]*2 > nd_mask0 ) break;
9071: if ( k < nd_nvar )
9072: nd_det_reconstruct(dm,n,j,d);
9073:
9074: for ( i = j+1, mj = dm[j], mjj = mj[j]; i < n; i++ ) {
9075: /* if ( DP_Print ) fprintf(asir_out," i=%d\n ",i); */
9076: mi = dm[i]; mij = mi[j];
9077: if ( mod )
9078: ndv_mul_c(mod,mij,mod-1);
9079: else
9080: ndv_mul_c_q(mij,mone);
9081: for ( k = j+1; k < n; k++ ) {
9082: /* if ( DP_Print ) fprintf(asir_out,"k=%d ",k); */
9083: bucket = create_pbucket();
9084: if ( mi[k] ) {
9085: nmv = BDY(mjj); len = LEN(mjj);
9086: for ( a = 0; a < len; a++, NMV_ADV(nmv) ) {
9087: u = ndv_mul_nmv_trunc(mod,nmv,mi[k],DL(BDY(d)));
9088: add_pbucket(mod,bucket,u);
9089: }
9090: }
9091: if ( mj[k] && mij ) {
9092: nmv = BDY(mij); len = LEN(mij);
9093: for ( a = 0; a < len; a++, NMV_ADV(nmv) ) {
9094: u = ndv_mul_nmv_trunc(mod,nmv,mj[k],DL(BDY(d)));
9095: add_pbucket(mod,bucket,u);
9096: }
9097: }
9098: u = nd_quo(mod,bucket,d);
9099: mi[k] = ndtondv(mod,u);
9100: }
9101: /* if ( DP_Print ) fprintf(asir_out,"\n",k); */
9102: }
9103: d = mjj;
9104: }
9105: if ( DP_Print ) {
9106: fprintf(asir_out,"\n");
9107: }
9108: if ( sgn < 0 ) {
9109: if ( mod )
9110: ndv_mul_c(mod,d,mod-1);
9111: else
9112: ndv_mul_c_q(d,mone);
9113: }
9114: r = ndvtop(mod,CO,fv,d);
9115: if ( !mod && !UNIQ(dq) )
9116: divsp(CO,r,(P)dq,rp);
9117: else
9118: *rp = r;
9119: }
9120:
9121: ND ndv_mul_nmv_trunc(int mod,NMV m0,NDV p,UINT *d)
9122: {
9123: NM mr,mr0;
9124: NM tnm;
9125: NMV m;
9126: UINT *d0,*dt,*dm;
9127: int c,n,td,i,c1,c2,len;
9128: Z q;
9129: ND r;
9130:
9131: if ( !p ) return 0;
9132: else {
9133: n = NV(p); m = BDY(p); len = LEN(p);
9134: d0 = DL(m0);
9135: td = TD(d);
9136: mr0 = 0;
9137: NEWNM(tnm);
9138: if ( mod ) {
9139: c = CM(m0);
9140: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
9141: ndl_add(DL(m),d0,DL(tnm));
9142: if ( ndl_reducible(DL(tnm),d) ) {
9143: NEXTNM(mr0,mr);
9144: c1 = CM(m); DMAR(c1,c,0,mod,c2); CM(mr) = c2;
9145: ndl_copy(DL(tnm),DL(mr));
9146: }
9147: }
9148: } else {
1.6 noro 9149: q = CZ(m0);
1.1 noro 9150: for ( i = 0; i < len; i++, NMV_ADV(m) ) {
9151: ndl_add(DL(m),d0,DL(tnm));
9152: if ( ndl_reducible(DL(tnm),d) ) {
9153: NEXTNM(mr0,mr);
1.6 noro 9154: mulz(CZ(m),q,&CZ(mr));
1.1 noro 9155: ndl_copy(DL(tnm),DL(mr));
9156: }
9157: }
9158: }
9159: if ( !mr0 )
9160: return 0;
9161: else {
9162: NEXT(mr) = 0;
9163: for ( len = 0, mr = mr0; mr; mr = NEXT(mr), len++ );
9164: MKND(NV(p),mr0,len,r);
9165: SG(r) = SG(p) + TD(d0);
9166: return r;
9167: }
9168: }
9169: }
9170:
9171: void nd_det_reconstruct(NDV **dm,int n,int j,NDV d)
9172: {
9173: int i,obpe,oadv,h,k,l;
9174: static NM prev_nm_free_list;
9175: EPOS oepos;
9176:
9177: obpe = nd_bpe;
9178: oadv = nmv_adv;
9179: oepos = nd_epos;
9180: if ( obpe < 2 ) nd_bpe = 2;
9181: else if ( obpe < 3 ) nd_bpe = 3;
9182: else if ( obpe < 4 ) nd_bpe = 4;
9183: else if ( obpe < 5 ) nd_bpe = 5;
9184: else if ( obpe < 6 ) nd_bpe = 6;
9185: else if ( obpe < 8 ) nd_bpe = 8;
9186: else if ( obpe < 10 ) nd_bpe = 10;
9187: else if ( obpe < 16 ) nd_bpe = 16;
9188: else if ( obpe < 32 ) nd_bpe = 32;
9189: else error("nd_det_reconstruct : exponent too large");
9190:
9191: nd_setup_parameters(nd_nvar,0);
9192: prev_nm_free_list = _nm_free_list;
9193: _nm_free_list = 0;
9194: for ( k = j; k < n; k++ )
9195: for (l = j; l < n; l++ )
9196: ndv_realloc(dm[k][l],obpe,oadv,oepos);
9197: ndv_realloc(d,obpe,oadv,oepos);
9198: prev_nm_free_list = 0;
9199: #if 0
9200: GC_gcollect();
9201: #endif
9202: }
9203:
9204: /* returns a UINT array containing degree bounds */
9205:
9206: UINT *nd_det_compute_bound(NDV **dm,int n,int j)
9207: {
9208: UINT *d0,*d1,*d,*t,*r;
9209: int k,l,i;
9210:
9211: d0 = (UINT *)MALLOC(nd_nvar*sizeof(UINT));
9212: for ( k = 0; k < nd_nvar; k++ ) d0[k] = 0;
9213: for ( k = j; k < n; k++ )
9214: for ( l = j; l < n; l++ )
9215: if ( dm[k][l] ) {
9216: d = ndv_compute_bound(dm[k][l]);
9217: for ( i = 0; i < nd_nvar; i++ )
9218: d0[i] = MAX(d0[i],d[i]);
9219: }
9220: return d0;
9221: }
9222:
9223: DL nd_separate_d(UINT *d,UINT *trans)
9224: {
9225: int n,td,i,e,j;
9226: DL a;
9227:
9228: ndl_zero(trans);
9229: td = 0;
9230: for ( i = 0; i < nd_ntrans; i++ ) {
9231: e = GET_EXP(d,i);
9232: PUT_EXP(trans,i,e);
9233: td += MUL_WEIGHT(e,i);
9234: }
9235: if ( nd_ntrans+nd_nalg < nd_nvar ) {
9236: /* homogenized */
9237: i = nd_nvar-1;
9238: e = GET_EXP(d,i);
9239: PUT_EXP(trans,i,e);
9240: td += MUL_WEIGHT(e,i);
9241: }
9242: TD(trans) = td;
9243: if ( nd_blockmask) ndl_weight_mask(trans);
9244: NEWDL(a,nd_nalg);
9245: td = 0;
9246: for ( i = 0; i < nd_nalg; i++ ) {
9247: j = nd_ntrans+i;
9248: e = GET_EXP(d,j);
9249: a->d[i] = e;
9250: td += e;
9251: }
9252: a->td = td;
9253: return a;
9254: }
9255:
9256: int nd_monic(int mod,ND *p)
9257: {
9258: UINT *trans,*t;
9259: DL alg;
9260: MP mp0,mp;
9261: NM m,m0,m1,ma0,ma,mb,mr0,mr;
9262: ND r;
9263: DL dl;
9264: DP nm;
9265: NDV ndv;
9266: DAlg inv,cd;
9267: ND s,c;
9268: Z l,mul;
9269: Z ln;
9270: int n,ntrans,i,e,td,is_lc,len;
9271: NumberField nf;
9272: struct oEGT eg0,eg1;
9273:
9274: if ( !(nf = get_numberfield()) )
9275: error("nd_monic : current_numberfield is not set");
9276:
9277: /* Q coef -> DAlg coef */
9278: NEWNM(ma0); ma = ma0;
9279: m = BDY(*p);
9280: is_lc = 1;
9281: while ( 1 ) {
9282: NEWMP(mp0); mp = mp0;
1.6 noro 9283: mp->c = (Obj)CZ(m);
1.1 noro 9284: mp->dl = nd_separate_d(DL(m),DL(ma));
9285: NEWNM(mb);
9286: for ( m = NEXT(m); m; m = NEXT(m) ) {
9287: alg = nd_separate_d(DL(m),DL(mb));
9288: if ( !ndl_equal(DL(ma),DL(mb)) )
9289: break;
1.6 noro 9290: NEXTMP(mp0,mp); mp->c = (Obj)CZ(m); mp->dl = alg;
1.1 noro 9291: }
9292: NEXT(mp) = 0;
9293: MKDP(nd_nalg,mp0,nm);
9294: MKDAlg(nm,ONE,cd);
9295: if ( is_lc == 1 ) {
9296: /* if the lc is a rational number, we have nothing to do */
9297: if ( !mp0->dl->td )
9298: return 1;
9299:
9300: get_eg(&eg0);
9301: invdalg(cd,&inv);
9302: get_eg(&eg1); add_eg(&eg_invdalg,&eg0,&eg1);
9303: /* check the validity of inv */
9304: if ( mod && !remqi((Q)inv->dn,mod) )
9305: return 0;
9306: CA(ma) = nf->one;
9307: is_lc = 0;
9308: ln = ONE;
9309: } else {
9310: muldalg(cd,inv,&CA(ma));
9311: lcmz(ln,CA(ma)->dn,&ln);
9312: }
9313: if ( m ) {
9314: NEXT(ma) = mb; ma = mb;
9315: } else {
9316: NEXT(ma) = 0;
9317: break;
9318: }
9319: }
9320: /* l = lcm(denoms) */
9321: l = ln;
9322: for ( mr0 = 0, m = ma0; m; m = NEXT(m) ) {
1.6 noro 9323: divsz(l,CA(m)->dn,&mul);
1.1 noro 9324: for ( mp = BDY(CA(m)->nm); mp; mp = NEXT(mp) ) {
9325: NEXTNM(mr0,mr);
1.6 noro 9326: mulz((Z)mp->c,mul,&CZ(mr));
1.1 noro 9327: dl = mp->dl;
9328: td = TD(DL(m));
9329: ndl_copy(DL(m),DL(mr));
9330: for ( i = 0; i < nd_nalg; i++ ) {
9331: e = dl->d[i];
9332: PUT_EXP(DL(mr),i+nd_ntrans,e);
9333: td += MUL_WEIGHT(e,i+nd_ntrans);
9334: }
9335: if ( nd_module ) MPOS(DL(mr)) = MPOS(DL(m));
9336: TD(DL(mr)) = td;
9337: if ( nd_blockmask) ndl_weight_mask(DL(mr));
9338: }
9339: }
9340: NEXT(mr) = 0;
9341: for ( len = 0, mr = mr0; mr; mr = NEXT(mr), len++ );
9342: MKND(NV(*p),mr0,len,r);
9343: /* XXX */
9344: SG(r) = SG(*p);
9345: nd_free(*p);
9346: *p = r;
9347: return 1;
9348: }
9349:
9350: NODE reverse_node(NODE n)
9351: {
9352: NODE t,t1;
9353:
9354: for ( t = 0; n; n = NEXT(n) ) {
9355: MKNODE(t1,BDY(n),t); t = t1;
9356: }
9357: return t;
9358: }
9359:
9360: P ndc_div(int mod,union oNDC a,union oNDC b)
9361: {
9362: union oNDC c;
9363: int inv,t;
9364:
9365: if ( mod == -1 ) c.m = _mulsf(a.m,_invsf(b.m));
1.10 noro 9366: else if ( mod == -2 ) divlf(a.z,b.z,&c.z);
1.1 noro 9367: else if ( mod ) {
9368: inv = invm(b.m,mod);
9369: DMAR(a.m,inv,0,mod,t); c.m = t;
9370: } else if ( nd_vc )
9371: divsp(nd_vc,a.p,b.p,&c.p);
9372: else
9373: divsz(a.z,b.z,&c.z);
9374: return ndctop(mod,c);
9375: }
9376:
9377: P ndctop(int mod,union oNDC c)
9378: {
9379: Z q;
9380: int e;
9381: GFS gfs;
9382:
9383: if ( mod == -1 ) {
9384: e = IFTOF(c.m); MKGFS(e,gfs); return (P)gfs;
9385: } else if ( mod == -2 ) {
1.10 noro 9386: q = c.z; return (P)q;
1.1 noro 9387: } else if ( mod > 0 ) {
1.6 noro 9388: STOZ(c.m,q); return (P)q;
1.1 noro 9389: } else
9390: return (P)c.p;
9391: }
9392:
9393: /* [0,0,0,cont] = p -> p/cont */
9394:
9395: void finalize_tracelist(int i,P cont)
9396: {
9397: LIST l;
9398: NODE node;
9399: Z iq;
9400:
9401: if ( !UNIQ(cont) ) {
9402: node = mknode(4,NULLP,NULLP,NULLP,cont);
9403: MKLIST(l,node); MKNODE(node,l,nd_tracelist);
9404: nd_tracelist = node;
9405: }
1.6 noro 9406: STOZ(i,iq);
1.1 noro 9407: nd_tracelist = reverse_node(nd_tracelist);
9408: MKLIST(l,nd_tracelist);
9409: node = mknode(2,iq,l); MKLIST(l,node);
9410: MKNODE(node,l,nd_alltracelist); MKLIST(l,node);
9411: nd_alltracelist = node; nd_tracelist = 0;
9412: }
9413:
9414: void conv_ilist(int demand,int trace,NODE g,int **indp)
9415: {
9416: int n,i,j;
9417: int *ind;
9418: NODE t;
9419:
9420: n = length(g);
9421: ind = (int *)MALLOC(n*sizeof(int));
9422: for ( i = 0, t = g; i < n; i++, t = NEXT(t) ) {
9423: j = (long)BDY(t); ind[i] = j;
9424: BDY(t) = (pointer)(demand?ndv_load(j):(trace?nd_ps_trace[j]:nd_ps[j]));
9425: }
9426: if ( indp ) *indp = ind;
9427: }
9428:
9429: void parse_nd_option(NODE opt)
9430: {
9431: NODE t,p,u;
9432: int i,s,n;
9433: char *key;
9434: Obj value;
9435:
9436: nd_gentrace = 0; nd_gensyz = 0; nd_nora = 0; nd_gbblock = 0;
9437: nd_newelim = 0; nd_intersect = 0; nd_nzlist = 0;
9438: nd_splist = 0; nd_check_splist = 0;
9439: nd_sugarweight = 0;
9440: nd_f4red =0;
9441: nd_rank0 = 0;
9442: for ( t = opt; t; t = NEXT(t) ) {
9443: p = BDY((LIST)BDY(t));
9444: key = BDY((STRING)BDY(p));
9445: value = (Obj)BDY(NEXT(p));
9446: if ( !strcmp(key,"gentrace") )
9447: nd_gentrace = value?1:0;
9448: else if ( !strcmp(key,"gensyz") )
9449: nd_gensyz = value?1:0;
9450: else if ( !strcmp(key,"nora") )
9451: nd_nora = value?1:0;
9452: else if ( !strcmp(key,"gbblock") ) {
9453: if ( value && OID(value) == O_LIST ) {
9454: u = BDY((LIST)value);
9455: nd_gbblock = MALLOC((2*length(u)+1)*sizeof(int));
9456: for ( i = 0; u; u = NEXT(u) ) {
9457: p = BDY((LIST)BDY(u));
1.6 noro 9458: s = nd_gbblock[i++] = ZTOS((Q)BDY(p));
9459: nd_gbblock[i++] = s+ZTOS((Q)BDY(NEXT(p)))-1;
1.1 noro 9460: }
9461: nd_gbblock[i] = -1;
9462: } else
9463: nd_gbblock = 0;
9464: } else if ( !strcmp(key,"newelim") )
9465: nd_newelim = value?1:0;
9466: else if ( !strcmp(key,"intersect") )
9467: nd_intersect = value?1:0;
1.17 noro 9468: else if ( !strcmp(key,"syzgen") )
9469: nd_intersect = ZTOS((Q)value);
1.1 noro 9470: else if ( !strcmp(key,"lf") )
9471: nd_lf = value?1:0;
9472: else if ( !strcmp(key,"trace") ) {
9473: if ( value ) {
9474: u = BDY((LIST)value);
9475: nd_nzlist = BDY((LIST)ARG2(u));
1.6 noro 9476: nd_bpe = ZTOS((Q)ARG3(u));
1.1 noro 9477: }
9478: } else if ( !strcmp(key,"f4red") ) {
1.6 noro 9479: nd_f4red = ZTOS((Q)value);
1.1 noro 9480: } else if ( !strcmp(key,"rank0") ) {
9481: nd_rank0 = value?1:0;
9482: } else if ( !strcmp(key,"splist") ) {
9483: nd_splist = value?1:0;
9484: } else if ( !strcmp(key,"check_splist") ) {
9485: nd_check_splist = BDY((LIST)value);
9486: } else if ( !strcmp(key,"sugarweight") ) {
9487: u = BDY((LIST)value);
9488: n = length(u);
9489: nd_sugarweight = MALLOC(n*sizeof(int));
9490: for ( i = 0; i < n; i++, u = NEXT(u) )
1.6 noro 9491: nd_sugarweight[i] = ZTOS((Q)BDY(u));
1.1 noro 9492: }
9493: }
9494: }
9495:
9496: ND mdptond(DP d);
9497: ND nd_mul_nm(int mod,NM m0,ND p);
9498: ND nd_mul_nm_lf(NM m0,ND p);
9499: ND *btog(NODE ti,ND **p,int nb,int mod);
9500: ND btog_one(NODE ti,ND *p,int nb,int mod);
9501: MAT nd_btog(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,MAT *rp);
9502: VECT nd_btog_one(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,int pos,MAT *rp);
9503:
9504: /* d:monomial */
9505: ND mdptond(DP d)
9506: {
9507: NM m;
9508: ND r;
9509:
9510: if ( OID(d) == 1 )
9511: r = ptond(CO,CO,(P)d);
9512: else {
9513: NEWNM(m);
9514: dltondl(NV(d),BDY(d)->dl,DL(m));
1.6 noro 9515: CZ(m) = (Z)BDY(d)->c;
1.1 noro 9516: NEXT(m) = 0;
9517: MKND(NV(d),m,1,r);
9518: }
9519: return r;
9520: }
9521:
9522: ND nd_mul_nm(int mod,NM m0,ND p)
9523: {
9524: UINT *d0;
9525: int c0,c1,c;
9526: NM tm,mr,mr0;
9527: ND r;
9528:
9529: if ( !p ) return 0;
9530: d0 = DL(m0);
9531: c0 = CM(m0);
9532: mr0 = 0;
9533: for ( tm = BDY(p); tm; tm = NEXT(tm) ) {
9534: NEXTNM(mr0,mr);
9535: c = CM(tm); DMAR(c0,c,0,mod,c1); CM(mr) = c1;
9536: ndl_add(d0,DL(tm),DL(mr));
9537: }
9538: NEXT(mr) = 0;
9539: MKND(NV(p),mr0,LEN(p),r);
9540: return r;
9541: }
9542:
9543: ND nd_mul_nm_lf(NM m0,ND p)
9544: {
9545: UINT *d0;
9546: Z c0,c1,c;
9547: NM tm,mr,mr0;
9548: ND r;
9549:
9550: if ( !p ) return 0;
9551: d0 = DL(m0);
9552: c0 = CZ(m0);
9553: mr0 = 0;
9554: for ( tm = BDY(p); tm; tm = NEXT(tm) ) {
9555: NEXTNM(mr0,mr);
9556: c = CZ(tm); mullf(c0,CZ(tm),&c1); CZ(mr) = c1;
9557: ndl_add(d0,DL(tm),DL(mr));
9558: }
9559: NEXT(mr) = 0;
9560: MKND(NV(p),mr0,LEN(p),r);
9561: return r;
9562: }
9563:
9564: ND *btog(NODE ti,ND **p,int nb,int mod)
9565: {
9566: PGeoBucket *r;
9567: int i,ci;
9568: NODE t,s;
9569: ND m,tp;
9570: ND *pi,*rd;
9571: P c;
9572:
9573: r = (PGeoBucket *)MALLOC(nb*sizeof(PGeoBucket));
9574: for ( i = 0; i < nb; i++ )
9575: r[i] = create_pbucket();
9576: for ( t = ti; t; t = NEXT(t) ) {
9577: s = BDY((LIST)BDY(t));
9578: if ( ARG0(s) ) {
9579: m = mdptond((DP)ARG2(s));
1.6 noro 9580: ptomp(mod,(P)HCZ(m),&c);
1.1 noro 9581: if ( (ci = ((MQ)c)->cont) != 0 ) {
9582: HCM(m) = ci;
1.6 noro 9583: pi = p[ZTOS((Q)ARG1(s))];
1.1 noro 9584: for ( i = 0; i < nb; i++ ) {
9585: tp = nd_mul_nm(mod,BDY(m),pi[i]);
9586: add_pbucket(mod,r[i],tp);
9587: }
9588: }
9589: ci = 1;
9590: } else {
9591: ptomp(mod,(P)ARG3(s),&c); ci = ((MQ)c)->cont;
9592: ci = invm(ci,mod);
9593: }
9594: }
9595: rd = (ND *)MALLOC(nb*sizeof(ND));
9596: for ( i = 0; i < nb; i++ )
9597: rd[i] = normalize_pbucket(mod,r[i]);
9598: if ( ci != 1 )
9599: for ( i = 0; i < nb; i++ ) nd_mul_c(mod,rd[i],ci);
9600: return rd;
9601: }
9602:
9603: /* YYY */
9604: ND *btog_lf(NODE ti,ND **p,int nb)
9605: {
9606: PGeoBucket *r;
9607: int i;
9608: NODE t,s;
9609: ND m,tp;
9610: ND *pi,*rd;
9611: LM lm;
9612: Z lf,c;
9613:
9614: r = (PGeoBucket *)MALLOC(nb*sizeof(PGeoBucket));
9615: for ( i = 0; i < nb; i++ )
9616: r[i] = create_pbucket();
9617: for ( t = ti; t; t = NEXT(t) ) {
9618: s = BDY((LIST)BDY(t));
9619: if ( ARG0(s) ) {
9620: m = mdptond((DP)ARG2(s));
1.6 noro 9621: simp_ff((Obj)HCZ(m),(Obj *)&lm);
1.1 noro 9622: if ( lm ) {
9623: lmtolf(lm,&lf); HCZ(m) = lf;
1.6 noro 9624: pi = p[ZTOS((Q)ARG1(s))];
1.1 noro 9625: for ( i = 0; i < nb; i++ ) {
9626: tp = nd_mul_nm_lf(BDY(m),pi[i]);
9627: add_pbucket(-2,r[i],tp);
9628: }
9629: }
9630: c = ONE;
9631: } else {
9632: simp_ff((Obj)ARG3(s),(Obj *)&lm); lmtolf(lm,&lf); invz(lf,current_mod_lf,&c);
9633: }
9634: }
9635: rd = (ND *)MALLOC(nb*sizeof(ND));
9636: for ( i = 0; i < nb; i++ )
9637: rd[i] = normalize_pbucket(-2,r[i]);
9638: for ( i = 0; i < nb; i++ ) nd_mul_c_lf(rd[i],c);
9639: return rd;
9640: }
9641:
9642: ND btog_one(NODE ti,ND *p,int nb,int mod)
9643: {
9644: PGeoBucket r;
9645: int i,ci,j;
9646: NODE t,s;
9647: ND m,tp;
9648: ND pi,rd;
9649: P c;
9650:
9651: r = create_pbucket();
9652: for ( t = ti; t; t = NEXT(t) ) {
9653: s = BDY((LIST)BDY(t));
9654: if ( ARG0(s) ) {
9655: m = mdptond((DP)ARG2(s));
1.6 noro 9656: ptomp(mod,(P)HCZ(m),&c);
1.1 noro 9657: if ( (ci = ((MQ)c)->cont) != 0 ) {
9658: HCM(m) = ci;
1.6 noro 9659: pi = p[j=ZTOS((Q)ARG1(s))];
1.1 noro 9660: if ( !pi ) {
9661: pi = nd_load_mod(j);
9662: tp = nd_mul_nm(mod,BDY(m),pi);
9663: nd_free(pi);
9664: add_pbucket(mod,r,tp);
9665: } else {
9666: tp = nd_mul_nm(mod,BDY(m),pi);
9667: add_pbucket(mod,r,tp);
9668: }
9669: }
9670: ci = 1;
9671: } else {
9672: ptomp(mod,(P)ARG3(s),&c); ci = ((MQ)c)->cont;
9673: ci = invm(ci,mod);
9674: }
9675: }
9676: rd = normalize_pbucket(mod,r);
9677: free_pbucket(r);
9678: if ( ci != 1 ) nd_mul_c(mod,rd,ci);
9679: return rd;
9680: }
9681:
9682: MAT nd_btog_lf(LIST f,LIST v,struct order_spec *ord,LIST tlist,MAT *rp);
9683:
9684: MAT nd_btog(LIST f,LIST v,int mod,struct order_spec *ord,LIST tlist,MAT *rp)
9685: {
9686: int i,j,n,m,nb,pi0,pi1,nvar;
9687: VL fv,tv,vv;
9688: NODE permtrace,perm,trace,intred,ind,t,pi,ti;
9689: ND **p;
9690: ND *c;
9691: ND u;
9692: P inv;
9693: MAT mat;
9694:
9695: if ( mod == -2 )
9696: return nd_btog_lf(f,v,ord,tlist,rp);
9697:
9698: parse_nd_option(current_option);
9699: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
9700: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
9701: switch ( ord->id ) {
9702: case 1:
9703: if ( ord->nv != nvar )
9704: error("nd_check : invalid order specification");
9705: break;
9706: default:
9707: break;
9708: }
9709: nd_init_ord(ord);
9710: #if 0
1.6 noro 9711: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 9712: #else
9713: nd_bpe = 32;
9714: #endif
9715: nd_setup_parameters(nvar,0);
9716: permtrace = BDY((LIST)ARG2(BDY(tlist)));
9717: intred = BDY((LIST)ARG3(BDY(tlist)));
9718: ind = BDY((LIST)ARG4(BDY(tlist)));
9719: perm = BDY((LIST)BDY(permtrace)); trace =NEXT(permtrace);
9720: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 9721: j = ZTOS((Q)BDY(BDY((LIST)BDY(t))));
1.1 noro 9722: if ( j > i ) i = j;
9723: }
9724: n = i+1;
9725: nb = length(BDY(f));
9726: p = (ND **)MALLOC(n*sizeof(ND *));
9727: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
9728: pi = BDY((LIST)BDY(t));
1.6 noro 9729: pi0 = ZTOS((Q)ARG0(pi)); pi1 = ZTOS((Q)ARG1(pi));
1.1 noro 9730: p[pi0] = c = (ND *)MALLOC(nb*sizeof(ND));
9731: ptomp(mod,(P)ARG2(pi),&inv);
9732: ((MQ)inv)->cont = invm(((MQ)inv)->cont,mod);
9733: u = ptond(CO,vv,(P)ONE);
9734: HCM(u) = ((MQ)inv)->cont;
9735: c[pi1] = u;
9736: }
9737: for ( t = trace,i=0; t; t = NEXT(t), i++ ) {
9738: printf("%d ",i); fflush(stdout);
9739: ti = BDY((LIST)BDY(t));
1.6 noro 9740: p[j=ZTOS((Q)ARG0(ti))] = btog(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 9741: }
9742: for ( t = intred, i=0; t; t = NEXT(t), i++ ) {
9743: printf("%d ",i); fflush(stdout);
9744: ti = BDY((LIST)BDY(t));
1.6 noro 9745: p[j=ZTOS((Q)ARG0(ti))] = btog(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 9746: }
9747: m = length(ind);
9748: MKMAT(mat,nb,m);
9749: for ( j = 0, t = ind; j < m; j++, t = NEXT(t) )
1.6 noro 9750: for ( i = 0, c = p[ZTOS((Q)BDY(t))]; i < nb; i++ )
1.1 noro 9751: BDY(mat)[i][j] = ndtodp(mod,c[i]);
9752: return mat;
9753: }
9754:
9755: MAT nd_btog_lf(LIST f,LIST v,struct order_spec *ord,LIST tlist,MAT *rp)
9756: {
9757: int i,j,n,m,nb,pi0,pi1,nvar;
9758: VL fv,tv,vv;
9759: NODE permtrace,perm,trace,intred,ind,t,pi,ti;
9760: ND **p;
9761: ND *c;
9762: ND u;
9763: MAT mat;
9764: LM lm;
9765: Z lf,inv;
9766:
9767: parse_nd_option(current_option);
9768: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
9769: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
9770: switch ( ord->id ) {
9771: case 1:
9772: if ( ord->nv != nvar )
9773: error("nd_check : invalid order specification");
9774: break;
9775: default:
9776: break;
9777: }
9778: nd_init_ord(ord);
9779: #if 0
1.6 noro 9780: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 9781: #else
9782: nd_bpe = 32;
9783: #endif
9784: nd_setup_parameters(nvar,0);
9785: permtrace = BDY((LIST)ARG2(BDY(tlist)));
9786: intred = BDY((LIST)ARG3(BDY(tlist)));
9787: ind = BDY((LIST)ARG4(BDY(tlist)));
9788: perm = BDY((LIST)BDY(permtrace)); trace =NEXT(permtrace);
9789: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 9790: j = ZTOS((Q)BDY(BDY((LIST)BDY(t))));
1.1 noro 9791: if ( j > i ) i = j;
9792: }
9793: n = i+1;
9794: nb = length(BDY(f));
9795: p = (ND **)MALLOC(n*sizeof(ND *));
9796: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
9797: pi = BDY((LIST)BDY(t));
1.6 noro 9798: pi0 = ZTOS((Q)ARG0(pi)); pi1 = ZTOS((Q)ARG1(pi));
1.1 noro 9799: p[pi0] = c = (ND *)MALLOC(nb*sizeof(ND));
9800: simp_ff((Obj)ARG2(pi),(Obj *)&lm); lmtolf(lm,&lf); invz(lf,current_mod_lf,&inv);
9801: u = ptond(CO,vv,(P)ONE);
9802: HCZ(u) = inv;
9803: c[pi1] = u;
9804: }
9805: for ( t = trace,i=0; t; t = NEXT(t), i++ ) {
9806: printf("%d ",i); fflush(stdout);
9807: ti = BDY((LIST)BDY(t));
1.6 noro 9808: p[j=ZTOS((Q)ARG0(ti))] = btog_lf(BDY((LIST)ARG1(ti)),p,nb);
1.1 noro 9809: }
9810: for ( t = intred, i=0; t; t = NEXT(t), i++ ) {
9811: printf("%d ",i); fflush(stdout);
9812: ti = BDY((LIST)BDY(t));
1.6 noro 9813: p[j=ZTOS((Q)ARG0(ti))] = btog_lf(BDY((LIST)ARG1(ti)),p,nb);
1.1 noro 9814: }
9815: m = length(ind);
9816: MKMAT(mat,nb,m);
9817: for ( j = 0, t = ind; j < m; j++, t = NEXT(t) )
1.6 noro 9818: for ( i = 0, c = p[ZTOS((Q)BDY(t))]; i < nb; i++ )
1.1 noro 9819: BDY(mat)[i][j] = ndtodp(-2,c[i]);
9820: return mat;
9821: }
9822:
9823: VECT nd_btog_one(LIST f,LIST v,int mod,struct order_spec *ord,
9824: LIST tlist,int pos,MAT *rp)
9825: {
9826: int i,j,n,m,nb,pi0,pi1,nvar;
9827: VL fv,tv,vv;
9828: NODE permtrace,perm,trace,intred,ind,t,pi,ti;
9829: ND *p;
9830: ND *c;
9831: ND u;
9832: P inv;
9833: VECT vect;
9834:
9835: if ( mod == -2 )
9836: error("nd_btog_one : not implemented yet for a large finite field");
9837:
9838: parse_nd_option(current_option);
9839: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
9840: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
9841: switch ( ord->id ) {
9842: case 1:
9843: if ( ord->nv != nvar )
9844: error("nd_check : invalid order specification");
9845: break;
9846: default:
9847: break;
9848: }
9849: nd_init_ord(ord);
9850: #if 0
1.6 noro 9851: nd_bpe = ZTOS((Q)ARG7(BDY(tlist)));
1.1 noro 9852: #else
9853: nd_bpe = 32;
9854: #endif
9855: nd_setup_parameters(nvar,0);
9856: permtrace = BDY((LIST)ARG2(BDY(tlist)));
9857: intred = BDY((LIST)ARG3(BDY(tlist)));
9858: ind = BDY((LIST)ARG4(BDY(tlist)));
9859: perm = BDY((LIST)BDY(permtrace)); trace =NEXT(permtrace);
9860: for ( i = length(perm)-1, t = trace; t; t = NEXT(t) ) {
1.6 noro 9861: j = ZTOS((Q)BDY(BDY((LIST)BDY(t))));
1.1 noro 9862: if ( j > i ) i = j;
9863: }
9864: n = i+1;
9865: nb = length(BDY(f));
9866: p = (ND *)MALLOC(n*sizeof(ND *));
9867: for ( t = perm, i = 0; t; t = NEXT(t), i++ ) {
9868: pi = BDY((LIST)BDY(t));
1.6 noro 9869: pi0 = ZTOS((Q)ARG0(pi)); pi1 = ZTOS((Q)ARG1(pi));
1.1 noro 9870: if ( pi1 == pos ) {
9871: ptomp(mod,(P)ARG2(pi),&inv);
9872: ((MQ)inv)->cont = invm(((MQ)inv)->cont,mod);
9873: u = ptond(CO,vv,(P)ONE);
9874: HCM(u) = ((MQ)inv)->cont;
9875: p[pi0] = u;
9876: }
9877: }
9878: for ( t = trace,i=0; t; t = NEXT(t), i++ ) {
9879: printf("%d ",i); fflush(stdout);
9880: ti = BDY((LIST)BDY(t));
1.6 noro 9881: p[j=ZTOS((Q)ARG0(ti))] = btog_one(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 9882: if ( Demand ) {
9883: nd_save_mod(p[j],j); nd_free(p[j]); p[j] = 0;
9884: }
9885: }
9886: for ( t = intred, i=0; t; t = NEXT(t), i++ ) {
9887: printf("%d ",i); fflush(stdout);
9888: ti = BDY((LIST)BDY(t));
1.6 noro 9889: p[j=ZTOS((Q)ARG0(ti))] = btog_one(BDY((LIST)ARG1(ti)),p,nb,mod);
1.1 noro 9890: if ( Demand ) {
9891: nd_save_mod(p[j],j); nd_free(p[j]); p[j] = 0;
9892: }
9893: }
9894: m = length(ind);
9895: MKVECT(vect,m);
9896: for ( j = 0, t = ind; j < m; j++, t = NEXT(t) ) {
1.6 noro 9897: u = p[ZTOS((Q)BDY(t))];
1.1 noro 9898: if ( !u ) {
1.6 noro 9899: u = nd_load_mod(ZTOS((Q)BDY(t)));
1.1 noro 9900: BDY(vect)[j] = ndtodp(mod,u);
9901: nd_free(u);
9902: } else
9903: BDY(vect)[j] = ndtodp(mod,u);
9904: }
9905: return vect;
9906: }
9907:
9908: void ndv_print_lf(NDV p)
9909: {
9910: NMV m;
9911: int i,len;
9912:
9913: if ( !p ) printf("0\n");
9914: else {
9915: len = LEN(p);
9916: for ( m = BDY(p), i = 0; i < len; i++, NMV_ADV(m) ) {
9917: printf("+");
9918: mpz_out_str(asir_out,10,BDY(CZ(m)));
9919: printf("*");
9920: ndl_print(DL(m));
9921: }
9922: printf("\n");
9923: }
9924: }
9925:
9926: void nd_f4_lf_trace(LIST f,LIST v,int trace,int homo,struct order_spec *ord,LIST *rp)
9927: {
9928: VL tv,fv,vv,vc,av;
9929: NODE fd,fd0,in0,in,r,r0,t,s,cand,alist;
9930: int m,nocheck,nvar,mindex,e,max;
9931: NDV c;
9932: NMV a;
9933: P p,zp;
9934: Q dmy;
9935: EPOS oepos;
9936: int obpe,oadv,wmax,i,len,cbpe,ishomo,nalg,mrank,trank,ompos;
9937: Alg alpha,dp;
9938: P poly;
9939: LIST f1,f2,zpl;
9940: Obj obj;
9941: NumberField nf;
9942: struct order_spec *ord1;
9943: struct oEGT eg_check,eg0,eg1;
9944: NODE tr,tl1,tl2,tl3,tl4;
9945: LIST l1,l2,l3,l4,l5;
9946: int *perm;
9947: int j,ret;
9948: NODE retn;
9949: Q jq,bpe;
9950:
9951: nd_module = 0;
9952: parse_nd_option(current_option);
9953: get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&nd_vc);
9954: if ( nd_vc )
9955: error("nd_f4_lf_trace : computation over a rational function field is not implemented");
9956: for ( nvar = 0, tv = vv; tv; tv = NEXT(tv), nvar++ );
9957: switch ( ord->id ) {
9958: case 1:
9959: if ( ord->nv != nvar )
9960: error("nd_f4_lf_trace : invalid order specification");
9961: break;
9962: default:
9963: break;
9964: }
9965:
9966: nd_ntrans = nvar;
9967: nd_nalg = 0;
9968:
9969: nocheck = 0;
9970: mindex = 0;
9971:
9972: /* do not use on-demand load/save */
9973: nd_demand = 0;
9974: m = trace > 1 ? trace : get_lprime(mindex);
9975: nd_init_ord(ord);
9976: mrank = 0;
9977: for ( t = BDY(f), max = 1; t; t = NEXT(t) )
9978: for ( tv = vv; tv; tv = NEXT(tv) ) {
9979: if ( nd_module ) {
9980: s = BDY((LIST)BDY(t));
9981: trank = length(s);
9982: mrank = MAX(mrank,trank);
9983: for ( ; s; s = NEXT(s) ) {
9984: e = getdeg(tv->v,(P)BDY(s));
9985: max = MAX(e,max);
9986: }
9987: } else {
9988: e = getdeg(tv->v,(P)BDY(t));
9989: max = MAX(e,max);
9990: }
9991: }
9992: nd_setup_parameters(nvar,max);
9993: obpe = nd_bpe; oadv = nmv_adv; oepos = nd_epos; ompos = nd_mpos;
9994: ishomo = 1;
9995: /* XXX */
9996: for ( in0 = 0, fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
9997: if ( nd_module ) {
9998: c = (pointer)pltondv(CO,vv,(LIST)BDY(t));
9999: } else {
10000: c = (pointer)ptondv(CO,vv,(P)BDY(t));
10001: }
10002: if ( ishomo )
10003: ishomo = ishomo && ndv_ishomo(c);
10004: if ( c ) {
10005: NEXTNODE(fd0,fd); BDY(fd) = (pointer)ndv_dup(0,c);
10006: ndv_mod(-2,c);
10007: NEXTNODE(in0,in); BDY(in) = (pointer)c;
10008: }
10009: }
10010: if ( in0 ) NEXT(in) = 0;
10011: if ( fd0 ) NEXT(fd) = 0;
10012: if ( !ishomo && homo ) {
10013: for ( t = in0, wmax = max; t; t = NEXT(t) ) {
10014: c = (NDV)BDY(t); len = LEN(c);
10015: for ( a = BDY(c), i = 0; i < len; i++, NMV_ADV(a) )
10016: wmax = MAX(TD(DL(a)),wmax);
10017: }
10018: homogenize_order(ord,nvar,&ord1);
10019: nd_init_ord(ord1);
10020: nd_setup_parameters(nvar+1,wmax);
10021: for ( t = fd0; t; t = NEXT(t) )
10022: ndv_homogenize((NDV)BDY(t),obpe,oadv,oepos,ompos);
10023: }
10024: if ( MaxDeg > 0 ) nocheck = 1;
1.24 noro 10025: ret = ndv_setup(-2,m,fd0,nd_gbblock?1:0,0,0);
1.1 noro 10026: if ( ret )
10027: cand = nd_f4_lf_trace_main(m,&perm);
10028: if ( !ret || !cand ) {
10029: *rp = 0; return;
10030: }
10031: if ( !ishomo && homo ) {
10032: /* dehomogenization */
10033: for ( t = cand; t; t = NEXT(t) ) ndv_dehomogenize((NDV)BDY(t),ord);
10034: nd_init_ord(ord);
10035: nd_setup_parameters(nvar,0);
10036: }
10037: cand = ndv_reducebase(cand,perm);
10038: cand = ndv_reduceall(-2,cand);
10039: cbpe = nd_bpe;
10040: get_eg(&eg0);
10041: if ( (ret = ndv_check_membership(-2,in0,obpe,oadv,oepos,cand)) != 0 ) {
10042: /* gbcheck : cand is a GB of Id(cand) ? */
10043: retn = nd_f4(-2,0,0);
10044: }
10045: if ( !retn ) {
10046: /* failure */
10047: *rp = 0; return;
10048: }
10049: get_eg(&eg1); init_eg(&eg_check); add_eg(&eg_check,&eg0,&eg1);
10050: if ( DP_Print )
1.5 noro 10051: fprintf(asir_out,"check=%.3fsec\n",eg_check.exectime);
1.1 noro 10052: /* dp->p */
10053: nd_bpe = cbpe;
10054: nd_setup_parameters(nd_nvar,0);
10055: for ( r = cand; r; r = NEXT(r) ) {
10056: if ( nd_module ) BDY(r) = ndvtopl(-2,CO,vv,BDY(r),mrank);
10057: else BDY(r) = (pointer)ndvtop(-2,CO,vv,BDY(r));
10058: }
10059: MKLIST(*rp,cand);
10060: }
10061:
10062: NODE nd_f4_lf_trace_main(int m,int **indp)
10063: {
10064: int i,nh,stat,index;
10065: NODE r,rm,g;
10066: ND_pairs d,l,l0,t;
10067: ND spol,red;
10068: NDV nf,redv,nfqv,nfv;
10069: NM s0,s;
10070: NODE rp0,srp0,nflist,nflist_lf;
10071: int nsp,nred,col,rank,len,k,j,a;
10072: UINT c;
10073: UINT **spmat;
10074: UINT *s0vect,*svect,*p,*v;
10075: int *colstat;
10076: IndArray *imat;
10077: int *rhead;
10078: int spcol,sprow;
10079: int sugar;
10080: PGeoBucket bucket;
10081: struct oEGT eg0,eg1,eg_f4;
10082:
10083: g = 0; d = 0;
10084: for ( i = 0; i < nd_psn; i++ ) {
10085: d = update_pairs(d,g,i,0);
10086: g = update_base(g,i);
10087: }
10088: while ( d ) {
10089: get_eg(&eg0);
10090: l = nd_minsugarp(d,&d);
10091: sugar = SG(l);
10092: if ( MaxDeg > 0 && sugar > MaxDeg ) break;
10093: bucket = create_pbucket();
10094: stat = nd_sp_f4(m,0,l,bucket);
10095: if ( !stat ) {
10096: for ( t = l; NEXT(t); t = NEXT(t) );
10097: NEXT(t) = d; d = l;
10098: d = nd_reconstruct(1,d);
10099: continue;
10100: }
10101: if ( bucket->m < 0 ) continue;
10102: col = nd_symbolic_preproc(bucket,0,&s0vect,&rp0);
10103: if ( !col ) {
10104: for ( t = l; NEXT(t); t = NEXT(t) );
10105: NEXT(t) = d; d = l;
10106: d = nd_reconstruct(1,d);
10107: continue;
10108: }
10109: get_eg(&eg1); init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg1);
10110: if ( DP_Print )
1.5 noro 10111: fprintf(asir_out,"\nsugar=%d,symb=%.3fsec,",sugar,eg_f4.exectime);
1.1 noro 10112: nflist = nd_f4_red(m,l,0,s0vect,col,rp0,&l0);
10113: if ( !l0 ) continue;
10114: l = l0;
10115:
10116: /* over LF */
10117: bucket = create_pbucket();
10118: stat = nd_sp_f4(-2,1,l,bucket);
10119: if ( !stat ) {
10120: for ( t = l; NEXT(t); t = NEXT(t) );
10121: NEXT(t) = d; d = l;
10122: d = nd_reconstruct(1,d);
10123: continue;
10124: }
10125: if ( bucket->m < 0 ) continue;
10126: col = nd_symbolic_preproc(bucket,1,&s0vect,&rp0);
10127: if ( !col ) {
10128: for ( t = l; NEXT(t); t = NEXT(t) );
10129: NEXT(t) = d; d = l;
10130: d = nd_reconstruct(1,d);
10131: continue;
10132: }
10133: nflist_lf = nd_f4_red(-2,l,1,s0vect,col,rp0,0);
10134: /* adding new bases */
10135: for ( rm = nflist, r = nflist_lf; r && rm; rm = NEXT(rm), r = NEXT(r) ) {
10136: nfv = (NDV)BDY(rm);
10137: nfqv = (NDV)BDY(r);
10138: if ( DL_COMPARE(HDL(nfv),HDL(nfqv)) ) return 0;
10139: ndv_removecont(m,nfv);
10140: ndv_removecont(-2,nfqv);
1.24 noro 10141: nh = ndv_newps(-2,nfv,nfqv);
1.1 noro 10142: d = update_pairs(d,g,nh,0);
10143: g = update_base(g,nh);
10144: }
10145: if ( r || rm ) return 0;
10146: }
10147: conv_ilist(nd_demand,1,g,indp);
10148: return g;
10149: }
10150:
1.7 noro 10151: #if SIZEOF_LONG==8
10152:
10153: NDV vect64_to_ndv(mp_limb_t *vect,int spcol,int col,int *rhead,UINT *s0vect)
10154: {
10155: int j,k,len;
10156: UINT *p;
10157: UINT c;
10158: NDV r;
10159: NMV mr0,mr;
10160:
10161: for ( j = 0, len = 0; j < spcol; j++ ) if ( vect[j] ) len++;
10162: if ( !len ) return 0;
10163: else {
10164: mr0 = (NMV)MALLOC_ATOMIC_IGNORE_OFF_PAGE(nmv_adv*len);
10165: #if 0
10166: ndv_alloc += nmv_adv*len;
10167: #endif
10168: mr = mr0;
10169: p = s0vect;
10170: for ( j = k = 0; j < col; j++, p += nd_wpd )
10171: if ( !rhead[j] ) {
10172: if ( (c = (UINT)vect[k++]) != 0 ) {
10173: ndl_copy(p,DL(mr)); CM(mr) = c; NMV_ADV(mr);
10174: }
10175: }
10176: MKNDV(nd_nvar,mr0,len,r);
10177: return r;
10178: }
10179: }
10180:
10181: int nd_to_vect64(int mod,UINT *s0,int n,ND d,mp_limb_t *r)
10182: {
10183: NM m;
1.11 noro 10184: UINT *t,*s,*u;
10185: int i,st,ed,md,prev,c;
1.7 noro 10186:
10187: for ( i = 0; i < n; i++ ) r[i] = 0;
1.11 noro 10188: prev = 0;
10189: for ( i = 0, m = BDY(d); m; m = NEXT(m) ) {
10190: t = DL(m);
10191: st = prev;
10192: ed = n;
10193: while ( ed > st ) {
10194: md = (st+ed)/2;
10195: u = s0+md*nd_wpd;
10196: c = DL_COMPARE(u,t);
10197: if ( c == 0 ) break;
10198: else if ( c > 0 ) st = md;
10199: else ed = md;
10200: }
10201: r[md] = (mp_limb_t)CM(m);
10202: prev = md;
1.7 noro 10203: }
10204: for ( i = 0; !r[i]; i++ );
10205: return i;
10206: }
10207:
10208: #define MOD128(a,c,m) ((a)=(((c)!=0||((a)>=(m)))?(((((U128)(c))<<64)+(a))%(m)):(a)))
10209:
10210: int ndv_reduce_vect64(int m,mp_limb_t *svect,mp_limb_t *cvect,int col,IndArray *imat,NM_ind_pair *rp0,int nred)
10211: {
10212: int i,j,k,len,pos,prev;
10213: mp_limb_t a,c,c1,c2;
10214: IndArray ivect;
10215: unsigned char *ivc;
10216: unsigned short *ivs;
10217: unsigned int *ivi;
10218: NDV redv;
10219: NMV mr;
10220: NODE rp;
10221: int maxrs;
10222:
10223: for ( i = 0; i < col; i++ ) cvect[i] = 0;
10224: maxrs = 0;
10225: for ( i = 0; i < nred; i++ ) {
10226: ivect = imat[i];
10227: k = ivect->head;
10228: a = svect[k]; c = cvect[k];
10229: MOD128(a,c,m);
10230: svect[k] = a; cvect[k] = 0;
10231: if ( (c = svect[k]) != 0 ) {
1.11 noro 10232: Nf4_red++;
1.7 noro 10233: maxrs = MAX(maxrs,rp0[i]->sugar);
10234: c = m-c; redv = nd_ps[rp0[i]->index];
10235: len = LEN(redv); mr = BDY(redv);
10236: svect[k] = 0; prev = k;
10237: switch ( ivect->width ) {
10238: case 1:
10239: ivc = ivect->index.c;
10240: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
10241: pos = prev+ivc[j]; c1 = CM(mr); prev = pos;
1.12 noro 10242: c2 = svect[pos]+c1*c;
10243: if ( c2 < svect[pos] ) cvect[pos]++;
10244: svect[pos] = c2;
1.7 noro 10245: }
10246: break;
10247: case 2:
10248: ivs = ivect->index.s;
10249: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
10250: pos = prev+ivs[j]; c1 = CM(mr); prev = pos;
1.12 noro 10251: c2 = svect[pos]+c1*c;
10252: if ( c2 < svect[pos] ) cvect[pos]++;
10253: svect[pos] = c2;
1.7 noro 10254: }
10255: break;
10256: case 4:
10257: ivi = ivect->index.i;
10258: for ( j = 1, NMV_ADV(mr); j < len; j++, NMV_ADV(mr) ) {
10259: pos = prev+ivi[j]; c1 = CM(mr); prev = pos;
1.12 noro 10260: c2 = svect[pos]+c1*c;
10261: if ( c2 < svect[pos] ) cvect[pos]++;
10262: svect[pos] = c2;
1.7 noro 10263: }
10264: break;
10265: }
10266: }
10267: }
10268: for ( i = 0; i < col; i++ ) {
10269: a = svect[i]; c = cvect[i]; MOD128(a,c,m); svect[i] = a;
10270: }
10271: return maxrs;
10272: }
10273:
10274: /* for Fp, 2^15=<p<2^29 */
10275:
10276: NODE nd_f4_red_mod64_main(int m,ND_pairs sp0,int nsp,UINT *s0vect,int col,
10277: NM_ind_pair *rvect,int *rhead,IndArray *imat,int nred,ND_pairs *nz)
10278: {
10279: int spcol,sprow,a;
10280: int i,j,k,l,rank;
10281: NODE r0,r;
10282: ND_pairs sp;
10283: ND spol;
10284: mp_limb_t **spmat;
10285: mp_limb_t *svect,*cvect;
10286: mp_limb_t *v;
10287: int *colstat;
10288: struct oEGT eg0,eg1,eg2,eg_f4,eg_f4_1,eg_f4_2;
10289: int maxrs;
10290: int *spsugar;
10291: ND_pairs *spactive;
10292:
10293: spcol = col-nred;
10294: get_eg(&eg0);
10295: /* elimination (1st step) */
10296: spmat = (mp_limb_t **)MALLOC(nsp*sizeof(mp_limb_t *));
10297: svect = (mp_limb_t *)MALLOC(col*sizeof(mp_limb_t));
10298: cvect = (mp_limb_t *)MALLOC(col*sizeof(mp_limb_t));
10299: spsugar = (int *)MALLOC(nsp*sizeof(int));
10300: spactive = !nz?0:(ND_pairs *)MALLOC(nsp*sizeof(ND_pairs));
10301: for ( a = sprow = 0, sp = sp0; a < nsp; a++, sp = NEXT(sp) ) {
10302: nd_sp(m,0,sp,&spol);
10303: if ( !spol ) continue;
10304: nd_to_vect64(m,s0vect,col,spol,svect);
10305: maxrs = ndv_reduce_vect64(m,svect,cvect,col,imat,rvect,nred);
10306: for ( i = 0; i < col; i++ ) if ( svect[i] ) break;
10307: if ( i < col ) {
10308: spmat[sprow] = v = (mp_limb_t *)MALLOC_ATOMIC(spcol*sizeof(mp_limb_t));
10309: for ( j = k = 0; j < col; j++ )
10310: if ( !rhead[j] ) v[k++] = (UINT)svect[j];
10311: spsugar[sprow] = MAX(maxrs,SG(spol));
10312: if ( nz )
10313: spactive[sprow] = sp;
10314: sprow++;
10315: }
10316: nd_free(spol);
10317: }
1.12 noro 10318: get_eg(&eg1); init_eg(&eg_f4_1); add_eg(&eg_f4_1,&eg0,&eg1); add_eg(&f4_elim1,&eg0,&eg1);
1.7 noro 10319: if ( DP_Print ) {
10320: fprintf(asir_out,"elim1=%.3fsec,",eg_f4_1.exectime);
10321: fflush(asir_out);
10322: }
10323: /* free index arrays */
10324: for ( i = 0; i < nred; i++ ) GCFREE(imat[i]->index.c);
10325:
10326: /* elimination (2nd step) */
10327: colstat = (int *)MALLOC(spcol*sizeof(int));
10328: rank = nd_gauss_elim_mod64(spmat,spsugar,spactive,sprow,spcol,m,colstat);
10329: r0 = 0;
10330: for ( i = 0; i < rank; i++ ) {
10331: NEXTNODE(r0,r); BDY(r) =
10332: (pointer)vect64_to_ndv(spmat[i],spcol,col,rhead,s0vect);
10333: SG((NDV)BDY(r)) = spsugar[i];
10334: GCFREE(spmat[i]);
10335: }
10336: if ( r0 ) NEXT(r) = 0;
10337:
10338: for ( ; i < sprow; i++ ) GCFREE(spmat[i]);
1.12 noro 10339: get_eg(&eg2); init_eg(&eg_f4_2); add_eg(&eg_f4_2,&eg1,&eg2); add_eg(&f4_elim2,&eg1,&eg2);
1.7 noro 10340: init_eg(&eg_f4); add_eg(&eg_f4,&eg0,&eg2);
10341: if ( DP_Print ) {
10342: fprintf(asir_out,"elim2=%.3fsec,",eg_f4_2.exectime);
10343: fprintf(asir_out,"nsp=%d,nred=%d,spmat=(%d,%d),rank=%d ",
10344: nsp,nred,sprow,spcol,rank);
10345: fprintf(asir_out,"%.3fsec,",eg_f4.exectime);
10346: }
10347: if ( nz ) {
10348: for ( i = 0; i < rank-1; i++ ) NEXT(spactive[i]) = spactive[i+1];
10349: if ( rank > 0 ) {
10350: NEXT(spactive[rank-1]) = 0;
10351: *nz = spactive[0];
10352: } else
10353: *nz = 0;
10354: }
10355: return r0;
10356: }
10357:
10358: int nd_gauss_elim_mod64(mp_limb_t **mat,int *sugar,ND_pairs *spactive,int row,int col,int md,int *colstat)
10359: {
10360: int i,j,k,l,rank,s;
10361: mp_limb_t inv;
10362: mp_limb_t a;
10363: UINT c;
10364: mp_limb_t *t,*pivot,*pk;
10365: UINT *ck;
10366: UINT **cmat;
10367: UINT *ct;
10368: ND_pairs pair;
10369:
10370: cmat = (UINT **)MALLOC(row*sizeof(UINT *));
10371: for ( i = 0; i < row; i++ ) {
10372: cmat[i] = MALLOC_ATOMIC(col*sizeof(UINT));
10373: bzero(cmat[i],col*sizeof(UINT));
10374: }
10375:
10376: for ( rank = 0, j = 0; j < col; j++ ) {
10377: for ( i = rank; i < row; i++ ) {
10378: a = mat[i][j]; c = cmat[i][j];
10379: MOD128(a,c,md);
10380: mat[i][j] = a; cmat[i][j] = 0;
10381: }
10382: for ( i = rank; i < row; i++ )
10383: if ( mat[i][j] )
10384: break;
10385: if ( i == row ) {
10386: colstat[j] = 0;
10387: continue;
10388: } else
10389: colstat[j] = 1;
10390: if ( i != rank ) {
10391: t = mat[i]; mat[i] = mat[rank]; mat[rank] = t;
10392: ct = cmat[i]; cmat[i] = cmat[rank]; cmat[rank] = ct;
10393: s = sugar[i]; sugar[i] = sugar[rank]; sugar[rank] = s;
10394: if ( spactive ) {
10395: pair = spactive[i]; spactive[i] = spactive[rank];
10396: spactive[rank] = pair;
10397: }
10398: }
10399: /* column j is normalized */
10400: s = sugar[rank];
10401: inv = invm((UINT)mat[rank][j],md);
10402: /* normalize pivot row */
10403: for ( k = j, pk = mat[rank]+j, ck = cmat[rank]+j; k < col; k++, pk++, ck++ ) {
10404: a = *pk; c = *ck; MOD128(a,c,md); *pk = (a*inv)%md; *ck = 0;
10405: }
10406: for ( i = rank+1; i < row; i++ ) {
10407: if ( (a = mat[i][j]) != 0 ) {
10408: sugar[i] = MAX(sugar[i],s);
10409: red_by_vect64(md,mat[i]+j,cmat[i]+j,mat[rank]+j,(int)(md-a),col-j);
1.11 noro 10410: Nf4_red++;
1.7 noro 10411: }
10412: }
10413: rank++;
10414: }
10415: for ( j = col-1, l = rank-1; j >= 0; j-- )
10416: if ( colstat[j] ) {
10417: for ( k = j, pk = mat[l]+j, ck = cmat[l]+j; k < col; k++, pk++, ck++ ) {
10418: a = *pk; c = *ck; MOD128(a,c,md); *pk = a; *ck = 0;
10419: }
10420: s = sugar[l];
10421: for ( i = 0; i < l; i++ ) {
10422: a = mat[i][j]; c = cmat[i][j]; MOD128(a,c,md); mat[i][j] = a; cmat[i][j] = 0;
10423: if ( a ) {
10424: sugar[i] = MAX(sugar[i],s);
10425: red_by_vect64(md,mat[i]+j,cmat[i]+j,mat[l]+j,(int)(md-a),col-j);
1.11 noro 10426: Nf4_red++;
1.7 noro 10427: }
10428: }
10429: l--;
10430: }
10431: for ( i = 0; i < row; i++ ) GCFREE(cmat[i]);
10432: GCFREE(cmat);
10433: return rank;
10434: }
10435: #endif
10436:
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