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