![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to dp.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / builtin|
Return to dp.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / builtin |
1.5 ! noro 1: /*
! 2: * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
! 3: * All rights reserved.
! 4: *
! 5: * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
! 6: * non-exclusive and royalty-free license to use, copy, modify and
! 7: * redistribute, solely for non-commercial and non-profit purposes, the
! 8: * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
! 9: * conditions of this Agreement. For the avoidance of doubt, you acquire
! 10: * only a limited right to use the SOFTWARE hereunder, and FLL or any
! 11: * third party developer retains all rights, including but not limited to
! 12: * copyrights, in and to the SOFTWARE.
! 13: *
! 14: * (1) FLL does not grant you a license in any way for commercial
! 15: * purposes. You may use the SOFTWARE only for non-commercial and
! 16: * non-profit purposes only, such as academic, research and internal
! 17: * business use.
! 18: * (2) The SOFTWARE is protected by the Copyright Law of Japan and
! 19: * international copyright treaties. If you make copies of the SOFTWARE,
! 20: * with or without modification, as permitted hereunder, you shall affix
! 21: * to all such copies of the SOFTWARE the above copyright notice.
! 22: * (3) An explicit reference to this SOFTWARE and its copyright owner
! 23: * shall be made on your publication or presentation in any form of the
! 24: * results obtained by use of the SOFTWARE.
! 25: * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
! 26: * e-mail at risa-admin@flab.fujitsu.co.jp of the detailed specification
! 27: * for such modification or the source code of the modified part of the
! 28: * SOFTWARE.
! 29: *
! 30: * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
! 31: * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
! 32: * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
! 33: * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
! 34: * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
! 35: * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
! 36: * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
! 37: * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
! 38: * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
! 39: * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
! 40: * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
! 41: * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
! 42: * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
! 43: * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
! 44: * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
! 45: * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
! 46: * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
! 47: *
! 48: * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.4 2000/07/14 08:26:39 noro Exp $
! 49: */
1.1 noro 50: #include "ca.h"
51: #include "base.h"
52: #include "parse.h"
53:
54: extern int dp_fcoeffs;
55:
56: void Pdp_ord(), Pdp_ptod(), Pdp_dtop();
57: void Pdp_ptozp(), Pdp_ptozp2(), Pdp_red(), Pdp_red2(), Pdp_lcm(), Pdp_redble();
58: void Pdp_sp(), Pdp_hm(), Pdp_ht(), Pdp_hc(), Pdp_rest(), Pdp_td(), Pdp_sugar();
59: void Pdp_cri1(),Pdp_cri2(),Pdp_subd(),Pdp_mod(),Pdp_red_mod(),Pdp_tdiv();
60: void Pdp_prim(),Pdp_red_coef(),Pdp_mag(),Pdp_set_kara(),Pdp_rat();
61: void Pdp_nf(),Pdp_true_nf(),Pdp_nf_ptozp();
62: void Pdp_nf_mod(),Pdp_true_nf_mod();
63: void Pdp_criB(),Pdp_nelim();
64: void Pdp_minp(),Pdp_nf_demand(),Pdp_sp_mod();
65: void Pdp_homo(),Pdp_dehomo();
66: void Pdp_gr_mod_main();
67: void Pdp_gr_main(),Pdp_gr_hm_main(),Pdp_gr_d_main(),Pdp_gr_flags();
68: void Pdp_f4_main(),Pdp_f4_mod_main();
69: void Pdp_gr_print();
70:
71: struct ftab dp_tab[] = {
72: {"dp_ord",Pdp_ord,-1},
73: {"dp_ptod",Pdp_ptod,2},
74: {"dp_dtop",Pdp_dtop,2},
75: {"dp_ptozp",Pdp_ptozp,1},
76: {"dp_ptozp2",Pdp_ptozp2,2},
77: {"dp_prim",Pdp_prim,1},
78: {"dp_redble",Pdp_redble,2},
79: {"dp_subd",Pdp_subd,2},
80: {"dp_red",Pdp_red,3},
81: {"dp_red_mod",Pdp_red_mod,4},
82: {"dp_sp",Pdp_sp,2},
83: {"dp_sp_mod",Pdp_sp_mod,3},
84: {"dp_lcm",Pdp_lcm,2},
85: {"dp_hm",Pdp_hm,1},
86: {"dp_ht",Pdp_ht,1},
87: {"dp_hc",Pdp_hc,1},
88: {"dp_rest",Pdp_rest,1},
89: {"dp_td",Pdp_td,1},
90: {"dp_sugar",Pdp_sugar,1},
91: {"dp_cri1",Pdp_cri1,2},
92: {"dp_cri2",Pdp_cri2,2},
93: {"dp_criB",Pdp_criB,3},
94: {"dp_minp",Pdp_minp,2},
95: {"dp_mod",Pdp_mod,3},
96: {"dp_rat",Pdp_rat,1},
97: {"dp_tdiv",Pdp_tdiv,2},
98: {"dp_red_coef",Pdp_red_coef,2},
99: {"dp_nelim",Pdp_nelim,-1},
100: {"dp_mag",Pdp_mag,1},
101: {"dp_set_kara",Pdp_set_kara,-1},
102: {"dp_nf",Pdp_nf,4},
103: {"dp_true_nf",Pdp_true_nf,4},
104: {"dp_nf_ptozp",Pdp_nf_ptozp,5},
105: {"dp_nf_demand",Pdp_nf_demand,5},
106: {"dp_nf_mod",Pdp_nf_mod,5},
107: {"dp_true_nf_mod",Pdp_true_nf_mod,5},
108: {"dp_homo",Pdp_homo,1},
109: {"dp_dehomo",Pdp_dehomo,1},
110: {"dp_gr_main",Pdp_gr_main,5},
111: /* {"dp_gr_hm_main",Pdp_gr_hm_main,5}, */
112: /* {"dp_gr_d_main",Pdp_gr_d_main,6}, */
113: {"dp_gr_mod_main",Pdp_gr_mod_main,5},
114: {"dp_f4_main",Pdp_f4_main,3},
115: {"dp_f4_mod_main",Pdp_f4_mod_main,4},
116: {"dp_gr_flags",Pdp_gr_flags,-1},
117: {"dp_gr_print",Pdp_gr_print,-1},
118: {0,0,0},
119: };
120:
121: extern int dp_nelim;
122: extern int dp_order_pair_length;
123: extern struct order_pair *dp_order_pair;
124: extern struct order_spec dp_current_spec;
125:
126: void Pdp_ord(arg,rp)
127: NODE arg;
128: Obj *rp;
129: {
130: struct order_spec spec;
131:
132: if ( !arg )
133: *rp = dp_current_spec.obj;
134: else if ( !create_order_spec((Obj)ARG0(arg),&spec) )
135: error("dp_ord : invalid order specification");
136: else {
137: initd(&spec); *rp = spec.obj;
138: }
139: }
140:
141: int create_order_spec(obj,spec)
142: Obj obj;
143: struct order_spec *spec;
144: {
145: int i,j,n,s,row,col;
146: struct order_pair *l;
147: NODE node,t,tn;
148: MAT m;
149: pointer **b;
150: int **w;
151:
152: if ( !obj || NUM(obj) ) {
153: spec->id = 0; spec->obj = obj;
154: spec->ord.simple = QTOS((Q)obj);
155: return 1;
156: } else if ( OID(obj) == O_LIST ) {
157: node = BDY((LIST)obj);
158: for ( n = 0, t = node; t; t = NEXT(t), n++ );
159: l = (struct order_pair *)MALLOC_ATOMIC(n*sizeof(struct order_pair));
160: for ( i = 0, t = node, s = 0; i < n; t = NEXT(t), i++ ) {
161: tn = BDY((LIST)BDY(t)); l[i].order = QTOS((Q)BDY(tn));
162: tn = NEXT(tn); l[i].length = QTOS((Q)BDY(tn));
163: s += l[i].length;
164: }
165: spec->id = 1; spec->obj = obj;
166: spec->ord.block.order_pair = l;
167: spec->ord.block.length = n; spec->nv = s;
168: return 1;
169: } else if ( OID(obj) == O_MAT ) {
170: m = (MAT)obj; row = m->row; col = m->col; b = BDY(m);
171: w = almat(row,col);
172: for ( i = 0; i < row; i++ )
173: for ( j = 0; j < col; j++ )
174: w[i][j] = QTOS((Q)b[i][j]);
175: spec->id = 2; spec->obj = obj;
176: spec->nv = col; spec->ord.matrix.row = row;
177: spec->ord.matrix.matrix = w;
178: return 1;
179: } else
180: return 0;
181: }
182:
183: void homogenize_order(old,n,new)
184: struct order_spec *old,*new;
185: int n;
186: {
187: struct order_pair *l;
188: int length,nv,row,i,j;
189: int **newm,**oldm;
190:
191: switch ( old->id ) {
192: case 0:
193: switch ( old->ord.simple ) {
194: case 0:
195: new->id = 0; new->ord.simple = 0; break;
196: case 1:
197: l = (struct order_pair *)
198: MALLOC_ATOMIC(2*sizeof(struct order_pair));
199: l[0].length = n; l[0].order = 1;
200: l[1].length = 1; l[1].order = 2;
201: new->id = 1;
202: new->ord.block.order_pair = l;
203: new->ord.block.length = 2; new->nv = n+1;
204: break;
205: case 2:
206: new->id = 0; new->ord.simple = 1; break;
207: case 3: case 4: case 5:
208: new->id = 0; new->ord.simple = old->ord.simple+3;
209: dp_nelim = n-1; break;
210: case 6: case 7: case 8: case 9:
211: new->id = 0; new->ord.simple = old->ord.simple; break;
212: default:
213: error("homogenize_order : invalid input");
214: }
215: break;
216: case 1:
217: length = old->ord.block.length;
218: l = (struct order_pair *)
219: MALLOC_ATOMIC((length+1)*sizeof(struct order_pair));
220: bcopy((char *)old->ord.block.order_pair,(char *)l,length*sizeof(struct order_pair));
221: l[length].order = 2; l[length].length = 1;
222: new->id = 1; new->nv = n+1;
223: new->ord.block.order_pair = l;
224: new->ord.block.length = length+1;
225: break;
226: case 2:
227: nv = old->nv; row = old->ord.matrix.row;
228: oldm = old->ord.matrix.matrix; newm = almat(row+1,nv+1);
229: for ( i = 0; i <= nv; i++ )
230: newm[0][i] = 1;
231: for ( i = 0; i < row; i++ ) {
232: for ( j = 0; j < nv; j++ )
233: newm[i+1][j] = oldm[i][j];
234: newm[i+1][j] = 0;
235: }
236: new->id = 2; new->nv = nv+1;
237: new->ord.matrix.row = row+1; new->ord.matrix.matrix = newm;
238: break;
239: default:
240: error("homogenize_order : invalid input");
241: }
242: }
243:
244: void Pdp_ptod(arg,rp)
245: NODE arg;
246: DP *rp;
247: {
248: NODE n;
249: VL vl,tvl;
250:
251: asir_assert(ARG0(arg),O_P,"dp_ptod");
252: asir_assert(ARG1(arg),O_LIST,"dp_ptod");
253: for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {
254: if ( !vl ) {
255: NEWVL(vl); tvl = vl;
256: } else {
257: NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
258: }
259: VR(tvl) = VR((P)BDY(n));
260: }
261: if ( vl )
262: NEXT(tvl) = 0;
263: ptod(CO,vl,(P)ARG0(arg),rp);
264: }
265:
266: void Pdp_dtop(arg,rp)
267: NODE arg;
268: P *rp;
269: {
270: NODE n;
271: VL vl,tvl;
272:
273: asir_assert(ARG0(arg),O_DP,"dp_dtop");
274: asir_assert(ARG1(arg),O_LIST,"dp_dtop");
275: for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {
276: if ( !vl ) {
277: NEWVL(vl); tvl = vl;
278: } else {
279: NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
280: }
281: VR(tvl) = VR((P)BDY(n));
282: }
283: if ( vl )
284: NEXT(tvl) = 0;
285: dtop(CO,vl,(DP)ARG0(arg),rp);
286: }
287:
288: extern LIST Dist;
289:
290: void Pdp_ptozp(arg,rp)
291: NODE arg;
292: DP *rp;
293: {
294: asir_assert(ARG0(arg),O_DP,"dp_ptozp");
295: #if INET
296: if ( Dist )
297: dp_ptozp_d(BDY(Dist),length(BDY(Dist)),(DP)ARG0(arg),rp);
298: else
299: #endif
300: dp_ptozp((DP)ARG0(arg),rp);
301: }
302:
303: void Pdp_ptozp2(arg,rp)
304: NODE arg;
305: LIST *rp;
306: {
307: DP p0,p1,h,r;
308: NODE n0;
309:
310: p0 = (DP)ARG0(arg); p1 = (DP)ARG1(arg);
311: asir_assert(p0,O_DP,"dp_ptozp2");
312: asir_assert(p1,O_DP,"dp_ptozp2");
313: #if INET
314: if ( Dist )
315: dp_ptozp2_d(BDY(Dist),length(BDY(Dist)),p0,p1,&h,&r);
316: else
317: #endif
318: dp_ptozp2(p0,p1,&h,&r);
319: NEWNODE(n0); BDY(n0) = (pointer)h;
320: NEWNODE(NEXT(n0)); BDY(NEXT(n0)) = (pointer)r;
321: NEXT(NEXT(n0)) = 0;
322: MKLIST(*rp,n0);
323: }
324:
325: void Pdp_prim(arg,rp)
326: NODE arg;
327: DP *rp;
328: {
329: DP t;
330:
331: asir_assert(ARG0(arg),O_DP,"dp_prim");
332: dp_prim((DP)ARG0(arg),&t); dp_ptozp(t,rp);
333: }
334:
335: extern int NoGCD;
336:
337: void dp_prim(p,rp)
338: DP p,*rp;
339: {
340: P t,g;
341: DP p1;
342: MP m,mr,mr0;
343: int i,n;
344: P *w;
345: Q *c;
346: Q dvr;
347:
348: if ( !p )
349: *rp = 0;
350: else if ( dp_fcoeffs )
351: *rp = p;
352: else if ( NoGCD )
353: dp_ptozp(p,rp);
354: else {
355: dp_ptozp(p,&p1); p = p1;
356: for ( m = BDY(p), n = 0; m; m = NEXT(m), n++ );
357: if ( n == 1 ) {
358: m = BDY(p);
359: NEWMP(mr); mr->dl = m->dl; mr->c = (P)ONE; NEXT(mr) = 0;
360: MKDP(p->nv,mr,*rp); (*rp)->sugar = p->sugar;
361: return;
362: }
363: w = (P *)ALLOCA(n*sizeof(P));
364: c = (Q *)ALLOCA(n*sizeof(Q));
365: for ( m =BDY(p), i = 0; i < n; m = NEXT(m), i++ )
366: if ( NUM(m->c) ) {
367: c[i] = (Q)m->c; w[i] = (P)ONE;
368: } else
369: ptozp(m->c,1,&c[i],&w[i]);
370: qltozl(c,n,&dvr); heu_nezgcdnpz(CO,w,n,&t); mulp(CO,t,(P)dvr,&g);
371: if ( NUM(g) )
372: *rp = p;
373: else {
374: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
375: NEXTMP(mr0,mr); divsp(CO,m->c,g,&mr->c); mr->dl = m->dl;
376: }
377: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
378: }
379: }
380: }
381:
382: void heu_nezgcdnpz(vl,pl,m,pr)
383: VL vl;
384: P *pl,*pr;
385: int m;
386: {
387: int i,r;
388: P gcd,t,s1,s2,u;
389: Q rq;
390:
391: while ( 1 ) {
392: for ( i = 0, s1 = 0; i < m; i++ ) {
393: r = random(); UTOQ(r,rq);
394: mulp(vl,pl[i],(P)rq,&t); addp(vl,s1,t,&u); s1 = u;
395: }
396: for ( i = 0, s2 = 0; i < m; i++ ) {
397: r = random(); UTOQ(r,rq);
398: mulp(vl,pl[i],(P)rq,&t); addp(vl,s2,t,&u); s2 = u;
399: }
400: ezgcdp(vl,s1,s2,&gcd);
401: for ( i = 0; i < m; i++ ) {
402: if ( !divtpz(vl,pl[i],gcd,&t) )
403: break;
404: }
405: if ( i == m )
406: break;
407: }
408: *pr = gcd;
409: }
410:
411: void dp_prim_mod(p,mod,rp)
412: int mod;
413: DP p,*rp;
414: {
415: P t,g;
416: MP m,mr,mr0;
417:
418: if ( !p )
419: *rp = 0;
420: else if ( NoGCD )
421: *rp = p;
422: else {
423: for ( m = BDY(p), g = m->c, m = NEXT(m); m; m = NEXT(m) ) {
424: gcdprsmp(CO,mod,g,m->c,&t); g = t;
425: }
426: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
427: NEXTMP(mr0,mr); divsmp(CO,mod,m->c,g,&mr->c); mr->dl = m->dl;
428: }
429: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
430: }
431: }
432:
433: void Pdp_mod(arg,rp)
434: NODE arg;
435: DP *rp;
436: {
437: DP p;
438: int mod;
439: NODE subst;
440:
441: asir_assert(ARG0(arg),O_DP,"dp_mod");
442: asir_assert(ARG1(arg),O_N,"dp_mod");
443: asir_assert(ARG2(arg),O_LIST,"dp_mod");
444: p = (DP)ARG0(arg); mod = QTOS((Q)ARG1(arg));
445: subst = BDY((LIST)ARG2(arg));
446: dp_mod(p,mod,subst,rp);
447: }
448:
449: void Pdp_rat(arg,rp)
450: NODE arg;
451: DP *rp;
452: {
453: asir_assert(ARG0(arg),O_DP,"dp_rat");
454: dp_rat((DP)ARG0(arg),rp);
455: }
456:
457: void dp_mod(p,mod,subst,rp)
458: DP p;
459: int mod;
460: NODE subst;
461: DP *rp;
462: {
463: MP m,mr,mr0;
464: P t,s,s1;
465: V v;
466: NODE tn;
467:
468: if ( !p )
469: *rp = 0;
470: else {
471: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
472: for ( tn = subst, s = m->c; tn; tn = NEXT(tn) ) {
473: v = VR((P)BDY(tn)); tn = NEXT(tn);
474: substp(CO,s,v,(P)BDY(tn),&s1); s = s1;
475: }
476: ptomp(mod,s,&t);
477: if ( t ) {
478: NEXTMP(mr0,mr); mr->c = t; mr->dl = m->dl;
479: }
480: }
481: if ( mr0 ) {
482: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
483: } else
484: *rp = 0;
485: }
486: }
487:
488: void dp_rat(p,rp)
489: DP p;
490: DP *rp;
491: {
492: MP m,mr,mr0;
493:
494: if ( !p )
495: *rp = 0;
496: else {
497: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
498: NEXTMP(mr0,mr); mptop(m->c,&mr->c); mr->dl = m->dl;
499: }
500: if ( mr0 ) {
501: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
502: } else
503: *rp = 0;
504: }
505: }
506:
507: void Pdp_nf(arg,rp)
508: NODE arg;
509: DP *rp;
510: {
511: NODE b;
512: DP *ps;
513: DP g;
514: int full;
515:
516: asir_assert(ARG0(arg),O_LIST,"dp_nf");
517: asir_assert(ARG1(arg),O_DP,"dp_nf");
518: asir_assert(ARG2(arg),O_VECT,"dp_nf");
519: asir_assert(ARG3(arg),O_N,"dp_nf");
520: if ( !(g = (DP)ARG1(arg)) ) {
521: *rp = 0; return;
522: }
523: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
524: full = (Q)ARG3(arg) ? 1 : 0;
525: dp_nf(b,g,ps,full,rp);
526: }
527:
528: void Pdp_true_nf(arg,rp)
529: NODE arg;
530: LIST *rp;
531: {
532: NODE b,n;
533: DP *ps;
534: DP g;
535: DP nm;
536: P dn;
537: int full;
538:
539: asir_assert(ARG0(arg),O_LIST,"dp_true_nf");
540: asir_assert(ARG1(arg),O_DP,"dp_true_nf");
541: asir_assert(ARG2(arg),O_VECT,"dp_true_nf");
542: asir_assert(ARG3(arg),O_N,"dp_nf");
543: if ( !(g = (DP)ARG1(arg)) ) {
544: nm = 0; dn = (P)ONE;
545: } else {
546: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
547: full = (Q)ARG3(arg) ? 1 : 0;
548: dp_true_nf(b,g,ps,full,&nm,&dn);
549: }
550: NEWNODE(n); BDY(n) = (pointer)nm;
551: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn;
552: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
553: }
554:
555: void dp_nf(b,g,ps,full,rp)
556: NODE b;
557: DP g;
558: DP *ps;
559: int full;
560: DP *rp;
561: {
1.4 noro 562: DP u,p,d,s,t,dmy1;
1.1 noro 563: P dmy;
564: NODE l;
565: MP m,mr;
566: int i,n;
567: int *wb;
568: int sugar,psugar;
569:
570: if ( !g ) {
571: *rp = 0; return;
572: }
573: for ( n = 0, l = b; l; l = NEXT(l), n++ );
574: wb = (int *)ALLOCA(n*sizeof(int));
575: for ( i = 0, l = b; i < n; l = NEXT(l), i++ )
576: wb[i] = QTOS((Q)BDY(l));
577: sugar = g->sugar;
578: for ( d = 0; g; ) {
579: for ( u = 0, i = 0; i < n; i++ ) {
580: if ( dp_redble(g,p = ps[wb[i]]) ) {
1.4 noro 581: dp_red(d,g,p,&t,&u,&dmy,&dmy1);
1.1 noro 582: psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar;
583: sugar = MAX(sugar,psugar);
584: if ( !u ) {
585: if ( d )
586: d->sugar = sugar;
587: *rp = d; return;
588: }
589: d = t;
590: break;
591: }
592: }
593: if ( u )
594: g = u;
595: else if ( !full ) {
596: if ( g ) {
597: MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t;
598: }
599: *rp = g; return;
600: } else {
601: m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c;
602: NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td;
603: addd(CO,d,t,&s); d = s;
604: dp_rest(g,&t); g = t;
605: }
606: }
607: if ( d )
608: d->sugar = sugar;
609: *rp = d;
610: }
611:
612: void dp_true_nf(b,g,ps,full,rp,dnp)
613: NODE b;
614: DP g;
615: DP *ps;
616: int full;
617: DP *rp;
618: P *dnp;
619: {
1.4 noro 620: DP u,p,d,s,t,dmy;
1.1 noro 621: NODE l;
622: MP m,mr;
623: int i,n;
624: int *wb;
625: int sugar,psugar;
626: P dn,tdn,tdn1;
627:
628: dn = (P)ONE;
629: if ( !g ) {
630: *rp = 0; *dnp = dn; return;
631: }
632: for ( n = 0, l = b; l; l = NEXT(l), n++ );
633: wb = (int *)ALLOCA(n*sizeof(int));
634: for ( i = 0, l = b; i < n; l = NEXT(l), i++ )
635: wb[i] = QTOS((Q)BDY(l));
636: sugar = g->sugar;
637: for ( d = 0; g; ) {
638: for ( u = 0, i = 0; i < n; i++ ) {
639: if ( dp_redble(g,p = ps[wb[i]]) ) {
1.4 noro 640: dp_red(d,g,p,&t,&u,&tdn,&dmy);
1.1 noro 641: psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar;
642: sugar = MAX(sugar,psugar);
643: if ( !u ) {
644: if ( d )
645: d->sugar = sugar;
646: *rp = d; *dnp = dn; return;
647: } else {
648: d = t;
649: mulp(CO,dn,tdn,&tdn1); dn = tdn1;
650: }
651: break;
652: }
653: }
654: if ( u )
655: g = u;
656: else if ( !full ) {
657: if ( g ) {
658: MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t;
659: }
660: *rp = g; *dnp = dn; return;
661: } else {
662: m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c;
663: NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td;
664: addd(CO,d,t,&s); d = s;
665: dp_rest(g,&t); g = t;
666: }
667: }
668: if ( d )
669: d->sugar = sugar;
670: *rp = d; *dnp = dn;
671: }
672:
673: #define HMAG(p) (p_mag(BDY(p)->c))
674:
675: void Pdp_nf_ptozp(arg,rp)
676: NODE arg;
677: DP *rp;
678: {
679: NODE b;
680: DP g;
681: DP *ps;
682: int full,multiple;
683:
684: asir_assert(ARG0(arg),O_LIST,"dp_nf_ptozp");
685: asir_assert(ARG1(arg),O_DP,"dp_nf_ptozp");
686: asir_assert(ARG2(arg),O_VECT,"dp_nf_ptozp");
687: asir_assert(ARG3(arg),O_N,"dp_nf_ptozp");
688: asir_assert(ARG4(arg),O_N,"dp_nf_ptozp");
689: if ( !(g = (DP)ARG1(arg)) ) {
690: *rp = 0; return;
691: }
692: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
693: full = (Q)ARG3(arg) ? 1 : 0;
694: multiple = QTOS((Q)ARG4(arg));
695: dp_nf_ptozp(b,g,ps,full,multiple,rp);
696: }
697:
698: void dp_nf_ptozp(b,g,ps,full,multiple,rp)
699: NODE b;
700: DP g;
701: DP *ps;
702: int full,multiple;
703: DP *rp;
704: {
1.4 noro 705: DP u,p,d,s,t,dmy1;
1.1 noro 706: P dmy;
707: NODE l;
708: MP m,mr;
709: int i,n;
710: int *wb;
711: int hmag;
712: int sugar,psugar;
713:
714: if ( !g ) {
715: *rp = 0; return;
716: }
717: for ( n = 0, l = b; l; l = NEXT(l), n++ );
718: wb = (int *)ALLOCA(n*sizeof(int));
719: for ( i = 0, l = b; i < n; l = NEXT(l), i++ )
720: wb[i] = QTOS((Q)BDY(l));
721: hmag = multiple*HMAG(g);
722: sugar = g->sugar;
723: for ( d = 0; g; ) {
724: for ( u = 0, i = 0; i < n; i++ ) {
725: if ( dp_redble(g,p = ps[wb[i]]) ) {
1.4 noro 726: dp_red(d,g,p,&t,&u,&dmy,&dmy1);
1.1 noro 727: psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar;
728: sugar = MAX(sugar,psugar);
729: if ( !u ) {
730: if ( d )
731: d->sugar = sugar;
732: *rp = d; return;
733: }
734: d = t;
735: break;
736: }
737: }
738: if ( u ) {
739: g = u;
740: if ( d ) {
741: if ( HMAG(d) > hmag ) {
742: dp_ptozp2(d,g,&t,&u); d = t; g = u;
743: hmag = multiple*HMAG(d);
744: }
745: } else {
746: if ( HMAG(g) > hmag ) {
747: dp_ptozp(g,&t); g = t;
748: hmag = multiple*HMAG(g);
749: }
750: }
751: }
752: else if ( !full ) {
753: if ( g ) {
754: MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t;
755: }
756: *rp = g; return;
757: } else {
758: m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c;
759: NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td;
760: addd(CO,d,t,&s); d = s;
761: dp_rest(g,&t); g = t;
762:
763: }
764: }
765: if ( d )
766: d->sugar = sugar;
767: *rp = d;
768: }
769:
770: void Pdp_nf_demand(arg,rp)
771: NODE arg;
772: DP *rp;
773: {
1.4 noro 774: DP g,u,p,d,s,t,dmy1;
1.1 noro 775: P dmy;
776: NODE b,l;
777: DP *hps;
778: MP m,mr;
779: int i,n;
780: int *wb;
781: int full;
782: char *fprefix;
783: int sugar,psugar;
784:
785: asir_assert(ARG0(arg),O_LIST,"dp_nf_demand");
786: asir_assert(ARG1(arg),O_DP,"dp_nf_demand");
787: asir_assert(ARG2(arg),O_N,"dp_nf_demand");
788: asir_assert(ARG3(arg),O_VECT,"dp_nf_demand");
789: asir_assert(ARG4(arg),O_STR,"dp_nf_demand");
790: if ( !(g = (DP)ARG1(arg)) ) {
791: *rp = 0; return;
792: }
793: b = BDY((LIST)ARG0(arg)); full = (Q)ARG2(arg) ? 1 : 0;
794: hps = (DP *)BDY((VECT)ARG3(arg)); fprefix = BDY((STRING)ARG4(arg));
795: for ( n = 0, l = b; l; l = NEXT(l), n++ );
796: wb = (int *)ALLOCA(n*sizeof(int));
797: for ( i = 0, l = b; i < n; l = NEXT(l), i++ )
798: wb[i] = QTOS((Q)BDY(l));
799: sugar = g->sugar;
800: for ( d = 0; g; ) {
801: for ( u = 0, i = 0; i < n; i++ ) {
802: if ( dp_redble(g,hps[wb[i]]) ) {
803: FILE *fp;
804: char fname[BUFSIZ];
805:
806: sprintf(fname,"%s%d",fprefix,wb[i]);
807: fprintf(stderr,"loading %s\n",fname);
808: fp = fopen(fname,"r"); skipvl(fp);
809: loadobj(fp,(Obj *)&p); fclose(fp);
1.4 noro 810: dp_red(d,g,p,&t,&u,&dmy,&dmy1);
1.1 noro 811: psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar;
812: sugar = MAX(sugar,psugar);
813: if ( !u ) {
814: if ( d )
815: d->sugar = sugar;
816: *rp = d; return;
817: }
818: d = t;
819: break;
820: }
821: }
822: if ( u )
823: g = u;
824: else if ( !full ) {
825: if ( g ) {
826: MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t;
827: }
828: *rp = g; return;
829: } else {
830: m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c;
831: NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td;
832: addd(CO,d,t,&s); d = s;
833: dp_rest(g,&t); g = t;
834:
835: }
836: }
837: if ( d )
838: d->sugar = sugar;
839: *rp = d;
840: }
841:
842: void Pdp_nf_mod(arg,rp)
843: NODE arg;
844: DP *rp;
845: {
846: NODE b;
847: DP g;
848: DP *ps;
849: int mod,full,ac;
850:
851: ac = argc(arg);
852: asir_assert(ARG0(arg),O_LIST,"dp_nf_mod");
853: asir_assert(ARG1(arg),O_DP,"dp_nf_mod");
854: asir_assert(ARG2(arg),O_VECT,"dp_nf_mod");
855: asir_assert(ARG3(arg),O_N,"dp_nf_mod");
856: asir_assert(ARG4(arg),O_N,"dp_nf_mod");
857: if ( !(g = (DP)ARG1(arg)) ) {
858: *rp = 0; return;
859: }
860: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
861: full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));
862: dp_nf_mod_qindex(b,g,ps,mod,full,rp);
863: }
864:
865: void Pdp_true_nf_mod(arg,rp)
866: NODE arg;
867: LIST *rp;
868: {
869: NODE b;
870: DP g,nm;
871: P dn;
872: DP *ps;
873: int mod,full;
874: NODE n;
875:
876: asir_assert(ARG0(arg),O_LIST,"dp_nf_mod");
877: asir_assert(ARG1(arg),O_DP,"dp_nf_mod");
878: asir_assert(ARG2(arg),O_VECT,"dp_nf_mod");
879: asir_assert(ARG3(arg),O_N,"dp_nf_mod");
880: asir_assert(ARG4(arg),O_N,"dp_nf_mod");
881: if ( !(g = (DP)ARG1(arg)) ) {
882: nm = 0; dn = (P)ONEM;
883: } else {
884: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
885: full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));
886: dp_true_nf_mod(b,g,ps,mod,full,&nm,&dn);
887: }
888: NEWNODE(n); BDY(n) = (pointer)nm;
889: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn;
890: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
891: }
892:
893: void dp_nf_mod_qindex(b,g,ps,mod,full,rp)
894: NODE b;
895: DP g;
896: DP *ps;
897: int mod,full;
898: DP *rp;
899: {
900: DP u,p,d,s,t;
901: P dmy;
902: NODE l;
903: MP m,mr;
904: int sugar,psugar;
905:
906: if ( !g ) {
907: *rp = 0; return;
908: }
909: sugar = g->sugar;
910: for ( d = 0; g; ) {
911: for ( u = 0, l = b; l; l = NEXT(l) ) {
912: if ( dp_redble(g,p = ps[QTOS((Q)BDY(l))]) ) {
913: dp_red_mod(d,g,p,mod,&t,&u,&dmy);
914: psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar;
915: sugar = MAX(sugar,psugar);
916: if ( !u ) {
917: if ( d )
918: d->sugar = sugar;
919: *rp = d; return;
920: }
921: d = t;
922: break;
923: }
924: }
925: if ( u )
926: g = u;
927: else if ( !full ) {
928: if ( g ) {
929: MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t;
930: }
931: *rp = g; return;
932: } else {
933: m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c;
934: NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td;
935: addmd(CO,mod,d,t,&s); d = s;
936: dp_rest(g,&t); g = t;
937: }
938: }
939: if ( d )
940: d->sugar = sugar;
941: *rp = d;
942: }
943:
944: void dp_nf_mod(b,g,ps,mod,full,rp)
945: NODE b;
946: DP g;
947: DP *ps;
948: int mod,full;
949: DP *rp;
950: {
951: DP u,p,d,s,t;
952: P dmy;
953: NODE l;
954: MP m,mr;
955: int sugar,psugar;
956:
957: if ( !g ) {
958: *rp = 0; return;
959: }
960: sugar = g->sugar;
961: for ( d = 0; g; ) {
962: for ( u = 0, l = b; l; l = NEXT(l) ) {
963: if ( dp_redble(g,p = ps[(int)BDY(l)]) ) {
964: dp_red_mod(d,g,p,mod,&t,&u,&dmy);
965: psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar;
966: sugar = MAX(sugar,psugar);
967: if ( !u ) {
968: if ( d )
969: d->sugar = sugar;
970: *rp = d; return;
971: }
972: d = t;
973: break;
974: }
975: }
976: if ( u )
977: g = u;
978: else if ( !full ) {
979: if ( g ) {
980: MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t;
981: }
982: *rp = g; return;
983: } else {
984: m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c;
985: NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td;
986: addmd(CO,mod,d,t,&s); d = s;
987: dp_rest(g,&t); g = t;
988: }
989: }
990: if ( d )
991: d->sugar = sugar;
992: *rp = d;
993: }
994:
995: void dp_true_nf_mod(b,g,ps,mod,full,rp,dnp)
996: NODE b;
997: DP g;
998: DP *ps;
999: int mod,full;
1000: DP *rp;
1001: P *dnp;
1002: {
1003: DP u,p,d,s,t;
1004: NODE l;
1005: MP m,mr;
1006: int i,n;
1007: int *wb;
1008: int sugar,psugar;
1009: P dn,tdn,tdn1;
1010:
1011: dn = (P)ONEM;
1012: if ( !g ) {
1013: *rp = 0; *dnp = dn; return;
1014: }
1015: for ( n = 0, l = b; l; l = NEXT(l), n++ );
1016: wb = (int *)ALLOCA(n*sizeof(int));
1017: for ( i = 0, l = b; i < n; l = NEXT(l), i++ )
1018: wb[i] = QTOS((Q)BDY(l));
1019: sugar = g->sugar;
1020: for ( d = 0; g; ) {
1021: for ( u = 0, i = 0; i < n; i++ ) {
1022: if ( dp_redble(g,p = ps[wb[i]]) ) {
1023: dp_red_mod(d,g,p,mod,&t,&u,&tdn);
1024: psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar;
1025: sugar = MAX(sugar,psugar);
1026: if ( !u ) {
1027: if ( d )
1028: d->sugar = sugar;
1029: *rp = d; *dnp = dn; return;
1030: } else {
1031: d = t;
1032: mulmp(CO,mod,dn,tdn,&tdn1); dn = tdn1;
1033: }
1034: break;
1035: }
1036: }
1037: if ( u )
1038: g = u;
1039: else if ( !full ) {
1040: if ( g ) {
1041: MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t;
1042: }
1043: *rp = g; *dnp = dn; return;
1044: } else {
1045: m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c;
1046: NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td;
1047: addmd(CO,mod,d,t,&s); d = s;
1048: dp_rest(g,&t); g = t;
1049: }
1050: }
1051: if ( d )
1052: d->sugar = sugar;
1053: *rp = d; *dnp = dn;
1054: }
1055:
1056: void Pdp_tdiv(arg,rp)
1057: NODE arg;
1058: DP *rp;
1059: {
1060: MP m,mr,mr0;
1061: DP p;
1062: Q c;
1063: N d,q,r;
1064: int sgn;
1065:
1066: asir_assert(ARG0(arg),O_DP,"dp_tdiv");
1067: asir_assert(ARG1(arg),O_N,"dp_tdiv");
1068: p = (DP)ARG0(arg); d = NM((Q)ARG1(arg)); sgn = SGN((Q)ARG1(arg));
1069: if ( !p )
1070: *rp = 0;
1071: else {
1072: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
1073: divn(NM((Q)m->c),d,&q,&r);
1074: if ( r ) {
1075: *rp = 0; return;
1076: } else {
1077: NEXTMP(mr0,mr); NTOQ(q,SGN((Q)m->c)*sgn,c);
1078: mr->c = (P)c; mr->dl = m->dl;
1079: }
1080: }
1081: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
1082: }
1083: }
1084:
1085: void Pdp_red_coef(arg,rp)
1086: NODE arg;
1087: DP *rp;
1088: {
1089: MP m,mr,mr0;
1090: P q,r;
1091: DP p;
1092: P mod;
1093:
1094: p = (DP)ARG0(arg); mod = (P)ARG1(arg);
1095: asir_assert(p,O_DP,"dp_red_coef");
1096: asir_assert(mod,O_P,"dp_red_coef");
1097: if ( !p )
1098: *rp = 0;
1099: else {
1100: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
1101: divsrp(CO,m->c,mod,&q,&r);
1102: if ( r ) {
1103: NEXTMP(mr0,mr); mr->c = r; mr->dl = m->dl;
1104: }
1105: }
1106: if ( mr0 ) {
1107: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
1108: } else
1109: *rp = 0;
1110: }
1111: }
1112:
1113: void qltozl(w,n,dvr)
1114: Q *w,*dvr;
1115: int n;
1116: {
1117: N nm,dn;
1118: N g,l1,l2,l3;
1119: Q c,d;
1120: int i;
1121: struct oVECT v;
1122:
1123: for ( i = 0; i < n; i++ )
1124: if ( w[i] && !INT(w[i]) )
1125: break;
1126: if ( i == n ) {
1127: v.id = O_VECT; v.len = n; v.body = (pointer *)w;
1128: igcdv(&v,dvr); return;
1129: }
1130: c = w[0]; nm = NM(c); dn = INT(c) ? ONEN : DN(c);
1131: for ( i = 1; i < n; i++ ) {
1132: c = w[i]; l1 = INT(c) ? ONEN : DN(c);
1133: gcdn(nm,NM(c),&g); nm = g;
1134: gcdn(dn,l1,&l2); muln(dn,l1,&l3); divsn(l3,l2,&dn);
1135: }
1136: if ( UNIN(dn) )
1137: NTOQ(nm,1,d);
1138: else
1139: NDTOQ(nm,dn,1,d);
1140: *dvr = d;
1141: }
1142:
1143: int comp_nm(a,b)
1144: Q *a,*b;
1145: {
1146: return cmpn((*a)?NM(*a):0,(*b)?NM(*b):0);
1147: }
1148:
1149: void sortbynm(w,n)
1150: Q *w;
1151: int n;
1152: {
1153: qsort(w,n,sizeof(Q),(int (*)(const void *,const void *))comp_nm);
1154: }
1155:
1156: void Pdp_redble(arg,rp)
1157: NODE arg;
1158: Q *rp;
1159: {
1160: asir_assert(ARG0(arg),O_DP,"dp_redble");
1161: asir_assert(ARG1(arg),O_DP,"dp_redble");
1162: if ( dp_redble((DP)ARG0(arg),(DP)ARG1(arg)) )
1163: *rp = ONE;
1164: else
1165: *rp = 0;
1166: }
1167:
1168: void Pdp_red_mod(arg,rp)
1169: NODE arg;
1170: LIST *rp;
1171: {
1172: DP h,r;
1173: P dmy;
1174: NODE n;
1175:
1176: asir_assert(ARG0(arg),O_DP,"dp_red_mod");
1177: asir_assert(ARG1(arg),O_DP,"dp_red_mod");
1178: asir_assert(ARG2(arg),O_DP,"dp_red_mod");
1179: asir_assert(ARG3(arg),O_N,"dp_red_mod");
1180: dp_red_mod((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),QTOS((Q)ARG3(arg)),
1181: &h,&r,&dmy);
1182: NEWNODE(n); BDY(n) = (pointer)h;
1183: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r;
1184: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
1185: }
1186:
1187: int dp_redble(p1,p2)
1188: DP p1,p2;
1189: {
1190: int i,n;
1191: DL d1,d2;
1192:
1193: d1 = BDY(p1)->dl; d2 = BDY(p2)->dl;
1194: if ( d1->td < d2->td )
1195: return 0;
1196: else {
1197: for ( i = 0, n = p1->nv; i < n; i++ )
1198: if ( d1->d[i] < d2->d[i] )
1199: return 0;
1200: return 1;
1201: }
1202: }
1203:
1204: void dp_red_mod(p0,p1,p2,mod,head,rest,dnp)
1205: DP p0,p1,p2;
1206: int mod;
1207: DP *head,*rest;
1208: P *dnp;
1209: {
1210: int i,n;
1211: DL d1,d2,d;
1212: MP m;
1213: DP t,s,r,h;
1214: P c1,c2,g,u;
1215:
1216: n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl;
1217: NEWDL(d,n); d->td = d1->td - d2->td;
1218: for ( i = 0; i < n; i++ )
1219: d->d[i] = d1->d[i]-d2->d[i];
1220: c1 = (P)BDY(p1)->c; c2 = (P)BDY(p2)->c;
1221: gcdprsmp(CO,mod,c1,c2,&g);
1222: divsmp(CO,mod,c1,g,&u); c1 = u; divsmp(CO,mod,c2,g,&u); c2 = u;
1223: if ( NUM(c2) ) {
1224: divsmp(CO,mod,c1,c2,&u); c1 = u; c2 = (P)ONEM;
1225: }
1226: NEWMP(m); m->dl = d; chsgnmp(mod,(P)c1,&m->c); NEXT(m) = 0;
1227: MKDP(n,m,s); s->sugar = d->td; mulmd(CO,mod,p2,s,&t);
1228: if ( NUM(c2) ) {
1229: addmd(CO,mod,p1,t,&r); h = p0;
1230: } else {
1231: mulmdc(CO,mod,p1,c2,&s); addmd(CO,mod,s,t,&r); mulmdc(CO,mod,p0,c2,&h);
1232: }
1233: *head = h; *rest = r; *dnp = c2;
1234: }
1235:
1236: void Pdp_subd(arg,rp)
1237: NODE arg;
1238: DP *rp;
1239: {
1240: DP p1,p2;
1241:
1242: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1243: asir_assert(p1,O_DP,"dp_subd");
1244: asir_assert(p2,O_DP,"dp_subd");
1245: dp_subd(p1,p2,rp);
1246: }
1247:
1248: void dp_subd(p1,p2,rp)
1249: DP p1,p2;
1250: DP *rp;
1251: {
1252: int i,n;
1253: DL d1,d2,d;
1254: MP m;
1255: DP s;
1256:
1257: n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl;
1258: NEWDL(d,n); d->td = d1->td - d2->td;
1259: for ( i = 0; i < n; i++ )
1260: d->d[i] = d1->d[i]-d2->d[i];
1.2 noro 1261: NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0;
1262: MKDP(n,m,s); s->sugar = d->td;
1263: *rp = s;
1264: }
1265:
1266: void dltod(d,n,rp)
1267: DL d;
1268: int n;
1269: DP *rp;
1270: {
1271: MP m;
1272: DP s;
1273:
1274: NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0;
1275: MKDP(n,m,s); s->sugar = d->td;
1.1 noro 1276: *rp = s;
1277: }
1278:
1279: void Pdp_red(arg,rp)
1280: NODE arg;
1281: LIST *rp;
1282: {
1283: NODE n;
1.4 noro 1284: DP head,rest,dmy1;
1.1 noro 1285: P dmy;
1286:
1287: asir_assert(ARG0(arg),O_DP,"dp_red");
1288: asir_assert(ARG1(arg),O_DP,"dp_red");
1289: asir_assert(ARG2(arg),O_DP,"dp_red");
1.4 noro 1290: dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1);
1.1 noro 1291: NEWNODE(n); BDY(n) = (pointer)head;
1292: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest;
1293: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
1294: }
1295:
1.4 noro 1296: void dp_red(p0,p1,p2,head,rest,dnp,multp)
1.1 noro 1297: DP p0,p1,p2;
1298: DP *head,*rest;
1299: P *dnp;
1.4 noro 1300: DP *multp;
1.1 noro 1301: {
1302: int i,n;
1303: DL d1,d2,d;
1304: MP m;
1305: DP t,s,r,h;
1306: Q c,c1,c2;
1307: N gn,tn;
1308: P g,a;
1309:
1310: n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl;
1311: NEWDL(d,n); d->td = d1->td - d2->td;
1312: for ( i = 0; i < n; i++ )
1313: d->d[i] = d1->d[i]-d2->d[i];
1314: c1 = (Q)BDY(p1)->c; c2 = (Q)BDY(p2)->c;
1315: if ( dp_fcoeffs ) {
1316: /* do nothing */
1317: } else if ( INT(c1) && INT(c2) ) {
1318: gcdn(NM(c1),NM(c2),&gn);
1319: if ( !UNIN(gn) ) {
1320: divsn(NM(c1),gn,&tn); NTOQ(tn,SGN(c1),c); c1 = c;
1321: divsn(NM(c2),gn,&tn); NTOQ(tn,SGN(c2),c); c2 = c;
1322: }
1323: } else {
1324: ezgcdpz(CO,(P)c1,(P)c2,&g);
1325: divsp(CO,(P)c1,g,&a); c1 = (Q)a; divsp(CO,(P)c2,g,&a); c2 = (Q)a;
1326: }
1327: NEWMP(m); m->dl = d; chsgnp((P)c1,&m->c); NEXT(m) = 0; MKDP(n,m,s); s->sugar = d->td;
1.4 noro 1328: *multp = s;
1.3 noro 1329: muld(CO,s,p2,&t); muldc(CO,p1,(P)c2,&s); addd(CO,s,t,&r);
1.1 noro 1330: muldc(CO,p0,(P)c2,&h);
1331: *head = h; *rest = r; *dnp = (P)c2;
1332: }
1333:
1334: void Pdp_sp(arg,rp)
1335: NODE arg;
1336: DP *rp;
1337: {
1338: DP p1,p2;
1339:
1340: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1341: asir_assert(p1,O_DP,"dp_sp"); asir_assert(p2,O_DP,"dp_sp");
1342: dp_sp(p1,p2,rp);
1343: }
1344:
1.4 noro 1345: extern int GenTrace;
1346: extern NODE TraceList;
1347:
1.1 noro 1348: void dp_sp(p1,p2,rp)
1349: DP p1,p2;
1350: DP *rp;
1351: {
1352: int i,n,td;
1353: int *w;
1354: DL d1,d2,d;
1355: MP m;
1.4 noro 1356: DP t,s1,s2,u;
1.1 noro 1357: Q c,c1,c2;
1358: N gn,tn;
1359:
1360: n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl;
1361: w = (int *)ALLOCA(n*sizeof(int));
1362: for ( i = 0, td = 0; i < n; i++ ) {
1363: w[i] = MAX(d1->d[i],d2->d[i]); td += w[i];
1364: }
1365:
1366: NEWDL(d,n); d->td = td - d1->td;
1367: for ( i = 0; i < n; i++ )
1368: d->d[i] = w[i] - d1->d[i];
1369: c1 = (Q)BDY(p1)->c; c2 = (Q)BDY(p2)->c;
1370: if ( INT(c1) && INT(c2) ) {
1371: gcdn(NM(c1),NM(c2),&gn);
1372: if ( !UNIN(gn) ) {
1373: divsn(NM(c1),gn,&tn); NTOQ(tn,SGN(c1),c); c1 = c;
1374: divsn(NM(c2),gn,&tn); NTOQ(tn,SGN(c2),c); c2 = c;
1375: }
1376: }
1377:
1378: NEWMP(m); m->dl = d; m->c = (P)c2; NEXT(m) = 0;
1.4 noro 1379: MKDP(n,m,s1); s1->sugar = d->td; muld(CO,s1,p1,&t);
1.1 noro 1380:
1381: NEWDL(d,n); d->td = td - d2->td;
1382: for ( i = 0; i < n; i++ )
1383: d->d[i] = w[i] - d2->d[i];
1384: NEWMP(m); m->dl = d; m->c = (P)c1; NEXT(m) = 0;
1.4 noro 1385: MKDP(n,m,s2); s2->sugar = d->td; muld(CO,s2,p2,&u);
1.1 noro 1386:
1387: subd(CO,t,u,rp);
1.4 noro 1388: if ( GenTrace ) {
1389: LIST hist;
1390: NODE node;
1391:
1392: node = mknode(4,ONE,0,s1,ONE);
1393: MKLIST(hist,node);
1394: MKNODE(TraceList,hist,0);
1395:
1396: node = mknode(4,ONE,0,0,ONE);
1397: chsgnd(s2,(DP *)&ARG2(node));
1398: MKLIST(hist,node);
1399: MKNODE(node,hist,TraceList); TraceList = node;
1400: }
1.1 noro 1401: }
1402:
1403: void Pdp_sp_mod(arg,rp)
1404: NODE arg;
1405: DP *rp;
1406: {
1407: DP p1,p2;
1408: int mod;
1409:
1410: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1411: asir_assert(p1,O_DP,"dp_sp_mod"); asir_assert(p2,O_DP,"dp_sp_mod");
1412: asir_assert(ARG2(arg),O_N,"dp_sp_mod");
1413: mod = QTOS((Q)ARG2(arg));
1414: dp_sp_mod(p1,p2,mod,rp);
1415: }
1416:
1417: void dp_sp_mod(p1,p2,mod,rp)
1418: DP p1,p2;
1419: int mod;
1420: DP *rp;
1421: {
1422: int i,n,td;
1423: int *w;
1424: DL d1,d2,d;
1425: MP m;
1426: DP t,s,u;
1427:
1428: n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl;
1429: w = (int *)ALLOCA(n*sizeof(int));
1430: for ( i = 0, td = 0; i < n; i++ ) {
1431: w[i] = MAX(d1->d[i],d2->d[i]); td += w[i];
1432: }
1433: NEWDL(d,n); d->td = td - d1->td;
1434: for ( i = 0; i < n; i++ )
1435: d->d[i] = w[i] - d1->d[i];
1436: NEWMP(m); m->dl = d; m->c = (P)BDY(p2)->c; NEXT(m) = 0;
1437: MKDP(n,m,s); s->sugar = d->td; mulmd(CO,mod,p1,s,&t);
1438: NEWDL(d,n); d->td = td - d2->td;
1439: for ( i = 0; i < n; i++ )
1440: d->d[i] = w[i] - d2->d[i];
1441: NEWMP(m); m->dl = d; m->c = (P)BDY(p1)->c; NEXT(m) = 0;
1442: MKDP(n,m,s); s->sugar = d->td; mulmd(CO,mod,p2,s,&u);
1443: submd(CO,mod,t,u,rp);
1444: }
1445:
1446: void Pdp_lcm(arg,rp)
1447: NODE arg;
1448: DP *rp;
1449: {
1450: int i,n,td;
1451: DL d1,d2,d;
1452: MP m;
1453: DP p1,p2;
1454:
1455: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1456: asir_assert(p1,O_DP,"dp_lcm"); asir_assert(p2,O_DP,"dp_lcm");
1457: n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl;
1458: NEWDL(d,n);
1459: for ( i = 0, td = 0; i < n; i++ ) {
1460: d->d[i] = MAX(d1->d[i],d2->d[i]); td += d->d[i];
1461: }
1462: d->td = td;
1463: NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0;
1464: MKDP(n,m,*rp); (*rp)->sugar = td; /* XXX */
1465: }
1466:
1467: void Pdp_hm(arg,rp)
1468: NODE arg;
1469: DP *rp;
1470: {
1471: DP p;
1472:
1473: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_hm");
1474: dp_hm(p,rp);
1475: }
1476:
1477: void dp_hm(p,rp)
1478: DP p;
1479: DP *rp;
1480: {
1481: MP m,mr;
1482:
1483: if ( !p )
1484: *rp = 0;
1485: else {
1486: m = BDY(p);
1487: NEWMP(mr); mr->dl = m->dl; mr->c = m->c; NEXT(mr) = 0;
1488: MKDP(p->nv,mr,*rp); (*rp)->sugar = mr->dl->td; /* XXX */
1489: }
1490: }
1491:
1492: void Pdp_ht(arg,rp)
1493: NODE arg;
1494: DP *rp;
1495: {
1496: DP p;
1497: MP m,mr;
1498:
1499: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_ht");
1500: if ( !p )
1501: *rp = 0;
1502: else {
1503: m = BDY(p);
1504: NEWMP(mr); mr->dl = m->dl; mr->c = (P)ONE; NEXT(mr) = 0;
1505: MKDP(p->nv,mr,*rp); (*rp)->sugar = mr->dl->td; /* XXX */
1506: }
1507: }
1508:
1509: void Pdp_hc(arg,rp)
1510: NODE arg;
1511: P *rp;
1512: {
1513: asir_assert(ARG0(arg),O_DP,"dp_hc");
1514: if ( !ARG0(arg) )
1515: *rp = 0;
1516: else
1517: *rp = BDY((DP)ARG0(arg))->c;
1518: }
1519:
1520: void Pdp_rest(arg,rp)
1521: NODE arg;
1522: DP *rp;
1523: {
1524: asir_assert(ARG0(arg),O_DP,"dp_rest");
1525: if ( !ARG0(arg) )
1526: *rp = 0;
1527: else
1528: dp_rest((DP)ARG0(arg),rp);
1529: }
1530:
1531: void dp_rest(p,rp)
1532: DP p,*rp;
1533: {
1534: MP m;
1535:
1536: m = BDY(p);
1537: if ( !NEXT(m) )
1538: *rp = 0;
1539: else {
1540: MKDP(p->nv,NEXT(m),*rp);
1541: if ( *rp )
1542: (*rp)->sugar = p->sugar;
1543: }
1544: }
1545:
1546: void Pdp_td(arg,rp)
1547: NODE arg;
1548: Q *rp;
1549: {
1550: DP p;
1551:
1552: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_td");
1553: if ( !p )
1554: *rp = 0;
1555: else
1556: STOQ(BDY(p)->dl->td,*rp);
1557: }
1558:
1559: void Pdp_sugar(arg,rp)
1560: NODE arg;
1561: Q *rp;
1562: {
1563: DP p;
1564:
1565: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_sugar");
1566: if ( !p )
1567: *rp = 0;
1568: else
1569: STOQ(p->sugar,*rp);
1570: }
1571:
1572: void Pdp_cri1(arg,rp)
1573: NODE arg;
1574: Q *rp;
1575: {
1576: DP p1,p2;
1577: int *d1,*d2;
1578: int i,n;
1579:
1580: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1581: asir_assert(p1,O_DP,"dp_cri1"); asir_assert(p2,O_DP,"dp_cri1");
1582: n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d;
1583: for ( i = 0; i < n; i++ )
1584: if ( d1[i] > d2[i] )
1585: break;
1586: *rp = i == n ? ONE : 0;
1587: }
1588:
1589: void Pdp_cri2(arg,rp)
1590: NODE arg;
1591: Q *rp;
1592: {
1593: DP p1,p2;
1594: int *d1,*d2;
1595: int i,n;
1596:
1597: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1598: asir_assert(p1,O_DP,"dp_cri2"); asir_assert(p2,O_DP,"dp_cri2");
1599: n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d;
1600: for ( i = 0; i < n; i++ )
1601: if ( MIN(d1[i],d2[i]) >= 1 )
1602: break;
1603: *rp = i == n ? ONE : 0;
1604: }
1605:
1606: void Pdp_minp(arg,rp)
1607: NODE arg;
1608: LIST *rp;
1609: {
1610: NODE tn,tn1,d,dd,dd0,p,tp;
1611: LIST l,minp;
1612: DP lcm,tlcm;
1613: int s,ts;
1614:
1615: asir_assert(ARG0(arg),O_LIST,"dp_minp");
1616: d = BDY((LIST)ARG0(arg)); minp = (LIST)BDY(d);
1617: p = BDY(minp); p = NEXT(NEXT(p)); lcm = (DP)BDY(p); p = NEXT(p);
1618: if ( !ARG1(arg) ) {
1619: s = QTOS((Q)BDY(p)); p = NEXT(p);
1620: for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) {
1621: tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp));
1622: tlcm = (DP)BDY(tp); tp = NEXT(tp);
1623: ts = QTOS((Q)BDY(tp)); tp = NEXT(tp);
1624: NEXTNODE(dd0,dd);
1625: if ( ts < s ) {
1626: BDY(dd) = (pointer)minp;
1627: minp = (LIST)BDY(d); lcm = tlcm; s = ts;
1628: } else if ( ts == s ) {
1629: if ( compd(CO,lcm,tlcm) > 0 ) {
1630: BDY(dd) = (pointer)minp;
1631: minp = (LIST)BDY(d); lcm = tlcm; s = ts;
1632: } else
1633: BDY(dd) = BDY(d);
1634: } else
1635: BDY(dd) = BDY(d);
1636: }
1637: } else {
1638: for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) {
1639: tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp));
1640: tlcm = (DP)BDY(tp);
1641: NEXTNODE(dd0,dd);
1642: if ( compd(CO,lcm,tlcm) > 0 ) {
1643: BDY(dd) = (pointer)minp; minp = (LIST)BDY(d); lcm = tlcm;
1644: } else
1645: BDY(dd) = BDY(d);
1646: }
1647: }
1648: if ( dd0 )
1649: NEXT(dd) = 0;
1650: MKLIST(l,dd0); MKNODE(tn,l,0); MKNODE(tn1,minp,tn); MKLIST(*rp,tn1);
1651: }
1652:
1653: void Pdp_criB(arg,rp)
1654: NODE arg;
1655: LIST *rp;
1656: {
1657: NODE d,ij,dd,ddd;
1658: int i,j,s,n;
1659: DP *ps;
1660: DL ts,ti,tj,lij,tdl;
1661:
1662: asir_assert(ARG0(arg),O_LIST,"dp_criB"); d = BDY((LIST)ARG0(arg));
1663: asir_assert(ARG1(arg),O_N,"dp_criB"); s = QTOS((Q)ARG1(arg));
1664: asir_assert(ARG2(arg),O_VECT,"dp_criB"); ps = (DP *)BDY((VECT)ARG2(arg));
1665: if ( !d )
1666: *rp = (LIST)ARG0(arg);
1667: else {
1668: ts = BDY(ps[s])->dl;
1669: n = ps[s]->nv;
1670: NEWDL(tdl,n);
1671: for ( dd = 0; d; d = NEXT(d) ) {
1672: ij = BDY((LIST)BDY(d));
1673: i = QTOS((Q)BDY(ij)); ij = NEXT(ij);
1674: j = QTOS((Q)BDY(ij)); ij = NEXT(ij);
1675: lij = BDY((DP)BDY(ij))->dl;
1676: ti = BDY(ps[i])->dl; tj = BDY(ps[j])->dl;
1677: if ( lij->td != lcm_of_DL(n,lij,ts,tdl)->td
1678: || !dl_equal(n,lij,tdl)
1679: || (lij->td == lcm_of_DL(n,ti,ts,tdl)->td
1680: && dl_equal(n,tdl,lij))
1681: || (lij->td == lcm_of_DL(n,tj,ts,tdl)->td
1682: && dl_equal(n,tdl,lij)) ) {
1683: MKNODE(ddd,BDY(d),dd);
1684: dd = ddd;
1685: }
1686: }
1687: MKLIST(*rp,dd);
1688: }
1689: }
1690:
1691: DL lcm_of_DL(nv,dl1,dl2,dl)
1692: int nv;
1693: DL dl1,dl2;
1694: register DL dl;
1695: {
1696: register int n, *d1, *d2, *d, td;
1697:
1698: if ( !dl ) NEWDL(dl,nv);
1699: d = dl->d, d1 = dl1->d, d2 = dl2->d;
1700: for ( td = 0, n = nv; --n >= 0; d1++, d2++, d++ )
1701: td += (*d = *d1 > *d2 ? *d1 : *d2 );
1702: dl->td = td;
1703: return dl;
1704: }
1705:
1706: int dl_equal(nv,dl1,dl2)
1707: int nv;
1708: DL dl1, dl2;
1709: {
1710: register int *d1, *d2, n;
1711:
1712: if ( dl1->td != dl2->td ) return 0;
1713: for ( d1 = dl1->d, d2 = dl2->d, n = nv; --n >= 0; d1++, d2++ )
1714: if ( *d1 != *d2 ) return 0;
1715: return 1;
1716: }
1717:
1718: void Pdp_nelim(arg,rp)
1719: NODE arg;
1720: Q *rp;
1721: {
1722: if ( arg ) {
1723: asir_assert(ARG0(arg),O_N,"dp_nelim");
1724: dp_nelim = QTOS((Q)ARG0(arg));
1725: }
1726: STOQ(dp_nelim,*rp);
1727: }
1728:
1729: void Pdp_mag(arg,rp)
1730: NODE arg;
1731: Q *rp;
1732: {
1733: DP p;
1734: int s;
1735: MP m;
1736:
1737: p = (DP)ARG0(arg);
1738: asir_assert(p,O_DP,"dp_mag");
1739: if ( !p )
1740: *rp = 0;
1741: else {
1742: for ( s = 0, m = BDY(p); m; m = NEXT(m) )
1743: s += p_mag(m->c);
1744: STOQ(s,*rp);
1745: }
1746: }
1747:
1748: extern int kara_mag;
1749:
1750: void Pdp_set_kara(arg,rp)
1751: NODE arg;
1752: Q *rp;
1753: {
1754: if ( arg ) {
1755: asir_assert(ARG0(arg),O_N,"dp_set_kara");
1756: kara_mag = QTOS((Q)ARG0(arg));
1757: }
1758: STOQ(kara_mag,*rp);
1759: }
1760:
1761: void Pdp_homo(arg,rp)
1762: NODE arg;
1763: DP *rp;
1764: {
1765: asir_assert(ARG0(arg),O_DP,"dp_homo");
1766: dp_homo((DP)ARG0(arg),rp);
1767: }
1768:
1769: void dp_homo(p,rp)
1770: DP p;
1771: DP *rp;
1772: {
1773: MP m,mr,mr0;
1774: int i,n,nv,td;
1775: DL dl,dlh;
1776:
1777: if ( !p )
1778: *rp = 0;
1779: else {
1780: n = p->nv; nv = n + 1;
1781: m = BDY(p); td = sugard(m);
1782: for ( mr0 = 0; m; m = NEXT(m) ) {
1783: NEXTMP(mr0,mr); mr->c = m->c;
1784: dl = m->dl;
1785: mr->dl = dlh = (DL)MALLOC_ATOMIC((nv+1)*sizeof(int));
1786: dlh->td = td;
1787: for ( i = 0; i < n; i++ )
1788: dlh->d[i] = dl->d[i];
1789: dlh->d[n] = td - dl->td;
1790: }
1791: NEXT(mr) = 0; MKDP(nv,mr0,*rp); (*rp)->sugar = p->sugar;
1792: }
1793: }
1794:
1795: void Pdp_dehomo(arg,rp)
1796: NODE arg;
1797: DP *rp;
1798: {
1799: asir_assert(ARG0(arg),O_DP,"dp_dehomo");
1800: dp_dehomo((DP)ARG0(arg),rp);
1801: }
1802:
1803: void dp_dehomo(p,rp)
1804: DP p;
1805: DP *rp;
1806: {
1807: MP m,mr,mr0;
1808: int i,n,nv;
1809: DL dl,dlh;
1810:
1811: if ( !p )
1812: *rp = 0;
1813: else {
1814: n = p->nv; nv = n - 1;
1815: m = BDY(p);
1816: for ( mr0 = 0; m; m = NEXT(m) ) {
1817: NEXTMP(mr0,mr); mr->c = m->c;
1818: dlh = m->dl;
1819: mr->dl = dl = (DL)MALLOC_ATOMIC((nv+1)*sizeof(int));
1820: dl->td = dlh->td - dlh->d[nv];
1821: for ( i = 0; i < nv; i++ )
1822: dl->d[i] = dlh->d[i];
1823: }
1824: NEXT(mr) = 0; MKDP(nv,mr0,*rp); (*rp)->sugar = p->sugar;
1825: }
1826: }
1827:
1828: int dp_nt(p)
1829: DP p;
1830: {
1831: int i;
1832: MP m;
1833:
1834: if ( !p )
1835: return 0;
1836: else {
1837: for ( i = 0, m = BDY(p); m; m = NEXT(m), i++ );
1838: return i;
1839: }
1840: }