Annotation of OpenXM_contrib2/asir2000/builtin/dp.c, Revision 1.8
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
1.6 noro 26: * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.5 noro 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: *
1.8 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.7 2000/12/05 01:24:50 noro Exp $
1.5 noro 49: */
1.1 noro 50: #include "ca.h"
51: #include "base.h"
52: #include "parse.h"
53:
54: extern int dp_fcoeffs;
1.8 ! noro 55: extern int dp_nelim;
! 56: extern int dp_order_pair_length;
! 57: extern struct order_pair *dp_order_pair;
! 58: extern struct order_spec dp_current_spec;
! 59:
1.1 noro 60:
61: void Pdp_ord(), Pdp_ptod(), Pdp_dtop();
62: void Pdp_ptozp(), Pdp_ptozp2(), Pdp_red(), Pdp_red2(), Pdp_lcm(), Pdp_redble();
63: void Pdp_sp(), Pdp_hm(), Pdp_ht(), Pdp_hc(), Pdp_rest(), Pdp_td(), Pdp_sugar();
64: void Pdp_cri1(),Pdp_cri2(),Pdp_subd(),Pdp_mod(),Pdp_red_mod(),Pdp_tdiv();
65: void Pdp_prim(),Pdp_red_coef(),Pdp_mag(),Pdp_set_kara(),Pdp_rat();
66: void Pdp_nf(),Pdp_true_nf(),Pdp_nf_ptozp();
67: void Pdp_nf_mod(),Pdp_true_nf_mod();
68: void Pdp_criB(),Pdp_nelim();
69: void Pdp_minp(),Pdp_nf_demand(),Pdp_sp_mod();
70: void Pdp_homo(),Pdp_dehomo();
71: void Pdp_gr_mod_main();
72: void Pdp_gr_main(),Pdp_gr_hm_main(),Pdp_gr_d_main(),Pdp_gr_flags();
73: void Pdp_f4_main(),Pdp_f4_mod_main();
74: void Pdp_gr_print();
1.8 ! noro 75: void Pdp_mbase(),Pdp_lnf_mod(),Pdp_nf_tab_mod(),Pdp_mdtod();
! 76: void Pdp_vtoe(), Pdp_etov(), Pdp_dtov(), Pdp_idiv(), Pdp_sep();
! 77: void Pdp_cont();
1.1 noro 78:
79: struct ftab dp_tab[] = {
1.8 ! noro 80: /* content reduction */
1.1 noro 81: {"dp_ptozp",Pdp_ptozp,1},
82: {"dp_ptozp2",Pdp_ptozp2,2},
83: {"dp_prim",Pdp_prim,1},
1.8 ! noro 84: {"dp_red_coef",Pdp_red_coef,2},
! 85: {"dp_cont",Pdp_cont,1},
! 86:
! 87: /* s-poly */
! 88: {"dp_sp",Pdp_sp,2},
! 89: {"dp_sp_mod",Pdp_sp_mod,3},
! 90:
! 91: /* m-reduction */
1.1 noro 92: {"dp_red",Pdp_red,3},
93: {"dp_red_mod",Pdp_red_mod,4},
1.8 ! noro 94:
! 95: /* normal form */
1.1 noro 96: {"dp_nf",Pdp_nf,4},
97: {"dp_true_nf",Pdp_true_nf,4},
98: {"dp_nf_ptozp",Pdp_nf_ptozp,5},
99: {"dp_nf_demand",Pdp_nf_demand,5},
100: {"dp_nf_mod",Pdp_nf_mod,5},
101: {"dp_true_nf_mod",Pdp_true_nf_mod,5},
1.8 ! noro 102: {"dp_lnf_mod",Pdp_lnf_mod,3},
! 103: {"dp_nf_tab_mod",Pdp_nf_tab_mod,3},
! 104:
! 105: /* Buchberger algorithm */
1.1 noro 106: {"dp_gr_main",Pdp_gr_main,5},
107: {"dp_gr_mod_main",Pdp_gr_mod_main,5},
1.8 ! noro 108:
! 109: /* F4 algorithm */
1.1 noro 110: {"dp_f4_main",Pdp_f4_main,3},
111: {"dp_f4_mod_main",Pdp_f4_mod_main,4},
1.8 ! noro 112:
! 113: {0,0,0},
! 114: };
! 115:
! 116: struct ftab dp_supp_tab[] = {
! 117: /* setting flags */
! 118: {"dp_ord",Pdp_ord,-1},
! 119: {"dp_set_kara",Pdp_set_kara,-1},
! 120: {"dp_nelim",Pdp_nelim,-1},
1.1 noro 121: {"dp_gr_flags",Pdp_gr_flags,-1},
122: {"dp_gr_print",Pdp_gr_print,-1},
1.8 ! noro 123:
! 124: /* converters */
! 125: {"dp_ptod",Pdp_ptod,2},
! 126: {"dp_dtop",Pdp_dtop,2},
! 127: {"dp_homo",Pdp_homo,1},
! 128: {"dp_dehomo",Pdp_dehomo,1},
! 129: {"dp_etov",Pdp_etov,1},
! 130: {"dp_vtoe",Pdp_vtoe,1},
! 131: {"dp_dtov",Pdp_dtov,1},
! 132: {"dp_mdtod",Pdp_mdtod,1},
! 133: {"dp_mod",Pdp_mod,3},
! 134: {"dp_rat",Pdp_rat,1},
! 135:
! 136: /* criteria */
! 137: {"dp_cri1",Pdp_cri1,2},
! 138: {"dp_cri2",Pdp_cri2,2},
! 139: {"dp_criB",Pdp_criB,3},
! 140:
! 141: /* simple operation */
! 142: {"dp_subd",Pdp_subd,2},
! 143: {"dp_lcm",Pdp_lcm,2},
! 144: {"dp_hm",Pdp_hm,1},
! 145: {"dp_ht",Pdp_ht,1},
! 146: {"dp_hc",Pdp_hc,1},
! 147: {"dp_rest",Pdp_rest,1},
! 148:
! 149: /* degree and size */
! 150: {"dp_td",Pdp_td,1},
! 151: {"dp_mag",Pdp_mag,1},
! 152: {"dp_sugar",Pdp_sugar,1},
! 153:
! 154: /* misc */
! 155: {"dp_mbase",Pdp_mbase,1},
! 156: {"dp_redble",Pdp_redble,2},
! 157: {"dp_sep",Pdp_sep,2},
! 158: {"dp_idiv",Pdp_idiv,2},
! 159: {"dp_tdiv",Pdp_tdiv,2},
! 160: {"dp_minp",Pdp_minp,2},
! 161:
! 162: {0,0,0}
1.1 noro 163: };
164:
1.8 ! noro 165: void Pdp_mdtod(arg,rp)
! 166: NODE arg;
! 167: DP *rp;
! 168: {
! 169: MP m,mr,mr0;
! 170: DP p;
! 171: P t;
! 172:
! 173: p = (DP)ARG0(arg);
! 174: if ( !p )
! 175: *rp = 0;
! 176: else {
! 177: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
! 178: mptop(m->c,&t); NEXTMP(mr0,mr); mr->c = t; mr->dl = m->dl;
! 179: }
! 180: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
! 181: }
! 182: }
! 183:
! 184: void Pdp_sep(arg,rp)
! 185: NODE arg;
! 186: VECT *rp;
! 187: {
! 188: DP p,r;
! 189: MP m,t;
! 190: MP *w0,*w;
! 191: int i,n,d,nv,sugar;
! 192: VECT v;
! 193: pointer *pv;
! 194:
! 195: p = (DP)ARG0(arg); m = BDY(p);
! 196: d = QTOS((Q)ARG1(arg));
! 197: for ( t = m, n = 0; t; t = NEXT(t), n++ );
! 198: if ( d > n )
! 199: d = n;
! 200: MKVECT(v,d); *rp = v;
! 201: pv = BDY(v); nv = p->nv; sugar = p->sugar;
! 202: w0 = (MP *)MALLOC(d*sizeof(MP)); bzero(w0,d*sizeof(MP));
! 203: w = (MP *)MALLOC(d*sizeof(MP)); bzero(w,d*sizeof(MP));
! 204: for ( t = BDY(p), i = 0; t; t = NEXT(t), i++, i %= d ) {
! 205: NEXTMP(w0[i],w[i]); w[i]->c = t->c; w[i]->dl = t->dl;
! 206: }
! 207: for ( i = 0; i < d; i++ ) {
! 208: NEXT(w[i]) = 0; MKDP(nv,w0[i],r); r->sugar = sugar;
! 209: pv[i] = (pointer)r;
! 210: }
! 211: }
! 212:
! 213: void Pdp_idiv(arg,rp)
! 214: NODE arg;
! 215: DP *rp;
! 216: {
! 217: dp_idiv((DP)ARG0(arg),(Q)ARG1(arg),rp);
! 218: }
! 219:
! 220: void Pdp_cont(arg,rp)
! 221: NODE arg;
! 222: Q *rp;
! 223: {
! 224: dp_cont((DP)ARG0(arg),rp);
! 225: }
! 226:
! 227: void Pdp_dtov(arg,rp)
! 228: NODE arg;
! 229: VECT *rp;
! 230: {
! 231: dp_dtov((DP)ARG0(arg),rp);
! 232: }
! 233:
! 234: void Pdp_mbase(arg,rp)
! 235: NODE arg;
! 236: LIST *rp;
! 237: {
! 238: NODE mb;
! 239:
! 240: asir_assert(ARG0(arg),O_LIST,"dp_mbase");
! 241: dp_mbase(BDY((LIST)ARG0(arg)),&mb);
! 242: MKLIST(*rp,mb);
! 243: }
! 244:
! 245: void Pdp_etov(arg,rp)
! 246: NODE arg;
! 247: VECT *rp;
! 248: {
! 249: DP dp;
! 250: int n,i;
! 251: int *d;
! 252: VECT v;
! 253: Q t;
! 254:
! 255: dp = (DP)ARG0(arg);
! 256: asir_assert(dp,O_DP,"dp_etov");
! 257: n = dp->nv; d = BDY(dp)->dl->d;
! 258: MKVECT(v,n);
! 259: for ( i = 0; i < n; i++ ) {
! 260: STOQ(d[i],t); v->body[i] = (pointer)t;
! 261: }
! 262: *rp = v;
! 263: }
! 264:
! 265: void Pdp_vtoe(arg,rp)
! 266: NODE arg;
! 267: DP *rp;
! 268: {
! 269: DP dp;
! 270: DL dl;
! 271: MP m;
! 272: int n,i,td;
! 273: int *d;
! 274: VECT v;
! 275:
! 276: v = (VECT)ARG0(arg);
! 277: asir_assert(v,O_VECT,"dp_vtoe");
! 278: n = v->len;
! 279: NEWDL(dl,n); d = dl->d;
! 280: for ( i = 0, td = 0; i < n; i++ ) {
! 281: d[i] = QTOS((Q)(v->body[i])); td += d[i];
! 282: }
! 283: dl->td = td;
! 284: NEWMP(m); m->dl = dl; m->c = (P)ONE; NEXT(m) = 0;
! 285: MKDP(n,m,dp); dp->sugar = td;
! 286: *rp = dp;
! 287: }
! 288:
! 289: void Pdp_lnf_mod(arg,rp)
! 290: NODE arg;
! 291: LIST *rp;
! 292: {
! 293: DP r1,r2;
! 294: NODE b,g,n;
! 295: int mod;
! 296:
! 297: asir_assert(ARG0(arg),O_LIST,"dp_lnf_mod");
! 298: asir_assert(ARG1(arg),O_LIST,"dp_lnf_mod");
! 299: asir_assert(ARG2(arg),O_N,"dp_lnf_mod");
! 300: b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg));
! 301: mod = QTOS((Q)ARG2(arg));
! 302: dp_lnf_mod((DP)BDY(b),(DP)BDY(NEXT(b)),g,mod,&r1,&r2);
! 303: NEWNODE(n); BDY(n) = (pointer)r1;
! 304: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2;
! 305: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
! 306: }
! 307:
! 308: void Pdp_nf_tab_mod(arg,rp)
! 309: NODE arg;
! 310: DP *rp;
! 311: {
! 312: asir_assert(ARG0(arg),O_DP,"dp_nf_tab_mod");
! 313: asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_mod");
! 314: asir_assert(ARG2(arg),O_N,"dp_nf_tab_mod");
! 315: dp_nf_tab_mod((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)),
! 316: QTOS((Q)ARG2(arg)),rp);
! 317: }
1.1 noro 318:
319: void Pdp_ord(arg,rp)
320: NODE arg;
321: Obj *rp;
322: {
323: struct order_spec spec;
324:
325: if ( !arg )
326: *rp = dp_current_spec.obj;
327: else if ( !create_order_spec((Obj)ARG0(arg),&spec) )
328: error("dp_ord : invalid order specification");
329: else {
330: initd(&spec); *rp = spec.obj;
331: }
332: }
333:
334: void Pdp_ptod(arg,rp)
335: NODE arg;
336: DP *rp;
337: {
338: NODE n;
339: VL vl,tvl;
340:
341: asir_assert(ARG0(arg),O_P,"dp_ptod");
342: asir_assert(ARG1(arg),O_LIST,"dp_ptod");
343: for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {
344: if ( !vl ) {
345: NEWVL(vl); tvl = vl;
346: } else {
347: NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
348: }
349: VR(tvl) = VR((P)BDY(n));
350: }
351: if ( vl )
352: NEXT(tvl) = 0;
353: ptod(CO,vl,(P)ARG0(arg),rp);
354: }
355:
356: void Pdp_dtop(arg,rp)
357: NODE arg;
358: P *rp;
359: {
360: NODE n;
361: VL vl,tvl;
362:
363: asir_assert(ARG0(arg),O_DP,"dp_dtop");
364: asir_assert(ARG1(arg),O_LIST,"dp_dtop");
365: for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {
366: if ( !vl ) {
367: NEWVL(vl); tvl = vl;
368: } else {
369: NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
370: }
371: VR(tvl) = VR((P)BDY(n));
372: }
373: if ( vl )
374: NEXT(tvl) = 0;
375: dtop(CO,vl,(DP)ARG0(arg),rp);
376: }
377:
378: extern LIST Dist;
379:
380: void Pdp_ptozp(arg,rp)
381: NODE arg;
382: DP *rp;
383: {
384: asir_assert(ARG0(arg),O_DP,"dp_ptozp");
385: if ( Dist )
386: dp_ptozp_d(BDY(Dist),length(BDY(Dist)),(DP)ARG0(arg),rp);
387: else
388: dp_ptozp((DP)ARG0(arg),rp);
389: }
390:
391: void Pdp_ptozp2(arg,rp)
392: NODE arg;
393: LIST *rp;
394: {
395: DP p0,p1,h,r;
396: NODE n0;
397:
398: p0 = (DP)ARG0(arg); p1 = (DP)ARG1(arg);
399: asir_assert(p0,O_DP,"dp_ptozp2");
400: asir_assert(p1,O_DP,"dp_ptozp2");
401: if ( Dist )
402: dp_ptozp2_d(BDY(Dist),length(BDY(Dist)),p0,p1,&h,&r);
403: else
404: dp_ptozp2(p0,p1,&h,&r);
405: NEWNODE(n0); BDY(n0) = (pointer)h;
406: NEWNODE(NEXT(n0)); BDY(NEXT(n0)) = (pointer)r;
407: NEXT(NEXT(n0)) = 0;
408: MKLIST(*rp,n0);
409: }
410:
411: void Pdp_prim(arg,rp)
412: NODE arg;
413: DP *rp;
414: {
415: DP t;
416:
417: asir_assert(ARG0(arg),O_DP,"dp_prim");
418: dp_prim((DP)ARG0(arg),&t); dp_ptozp(t,rp);
419: }
420:
421: void Pdp_mod(arg,rp)
422: NODE arg;
423: DP *rp;
424: {
425: DP p;
426: int mod;
427: NODE subst;
428:
429: asir_assert(ARG0(arg),O_DP,"dp_mod");
430: asir_assert(ARG1(arg),O_N,"dp_mod");
431: asir_assert(ARG2(arg),O_LIST,"dp_mod");
432: p = (DP)ARG0(arg); mod = QTOS((Q)ARG1(arg));
433: subst = BDY((LIST)ARG2(arg));
434: dp_mod(p,mod,subst,rp);
435: }
436:
437: void Pdp_rat(arg,rp)
438: NODE arg;
439: DP *rp;
440: {
441: asir_assert(ARG0(arg),O_DP,"dp_rat");
442: dp_rat((DP)ARG0(arg),rp);
443: }
444:
445: void Pdp_nf(arg,rp)
446: NODE arg;
447: DP *rp;
448: {
449: NODE b;
450: DP *ps;
451: DP g;
452: int full;
453:
454: asir_assert(ARG0(arg),O_LIST,"dp_nf");
455: asir_assert(ARG1(arg),O_DP,"dp_nf");
456: asir_assert(ARG2(arg),O_VECT,"dp_nf");
457: asir_assert(ARG3(arg),O_N,"dp_nf");
458: if ( !(g = (DP)ARG1(arg)) ) {
459: *rp = 0; return;
460: }
461: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
462: full = (Q)ARG3(arg) ? 1 : 0;
463: dp_nf(b,g,ps,full,rp);
464: }
465:
466: void Pdp_true_nf(arg,rp)
467: NODE arg;
468: LIST *rp;
469: {
470: NODE b,n;
471: DP *ps;
472: DP g;
473: DP nm;
474: P dn;
475: int full;
476:
477: asir_assert(ARG0(arg),O_LIST,"dp_true_nf");
478: asir_assert(ARG1(arg),O_DP,"dp_true_nf");
479: asir_assert(ARG2(arg),O_VECT,"dp_true_nf");
480: asir_assert(ARG3(arg),O_N,"dp_nf");
481: if ( !(g = (DP)ARG1(arg)) ) {
482: nm = 0; dn = (P)ONE;
483: } else {
484: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
485: full = (Q)ARG3(arg) ? 1 : 0;
486: dp_true_nf(b,g,ps,full,&nm,&dn);
487: }
488: NEWNODE(n); BDY(n) = (pointer)nm;
489: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn;
490: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
491: }
492:
1.8 ! noro 493: void Pdp_nf_ptozp(arg,rp)
! 494: NODE arg;
1.1 noro 495: DP *rp;
496: {
1.8 ! noro 497: NODE b;
! 498: DP g;
! 499: DP *ps;
! 500: int full,multiple;
1.1 noro 501:
1.8 ! noro 502: asir_assert(ARG0(arg),O_LIST,"dp_nf_ptozp");
! 503: asir_assert(ARG1(arg),O_DP,"dp_nf_ptozp");
! 504: asir_assert(ARG2(arg),O_VECT,"dp_nf_ptozp");
! 505: asir_assert(ARG3(arg),O_N,"dp_nf_ptozp");
! 506: asir_assert(ARG4(arg),O_N,"dp_nf_ptozp");
! 507: if ( !(g = (DP)ARG1(arg)) ) {
1.1 noro 508: *rp = 0; return;
509: }
1.8 ! noro 510: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
! 511: full = (Q)ARG3(arg) ? 1 : 0;
! 512: multiple = QTOS((Q)ARG4(arg));
! 513: dp_nf_ptozp(b,g,ps,full,multiple,rp);
! 514: }
1.1 noro 515:
516: void Pdp_nf_demand(arg,rp)
517: NODE arg;
518: DP *rp;
519: {
1.8 ! noro 520: DP g,u,p,d,s,t,dmy1;
! 521: P dmy;
! 522: NODE b,l;
! 523: DP *hps;
1.1 noro 524: MP m,mr;
525: int i,n;
526: int *wb;
1.8 ! noro 527: int full;
! 528: char *fprefix;
1.1 noro 529: int sugar,psugar;
530:
1.8 ! noro 531: asir_assert(ARG0(arg),O_LIST,"dp_nf_demand");
! 532: asir_assert(ARG1(arg),O_DP,"dp_nf_demand");
! 533: asir_assert(ARG2(arg),O_N,"dp_nf_demand");
! 534: asir_assert(ARG3(arg),O_VECT,"dp_nf_demand");
! 535: asir_assert(ARG4(arg),O_STR,"dp_nf_demand");
! 536: if ( !(g = (DP)ARG1(arg)) ) {
! 537: *rp = 0; return;
1.1 noro 538: }
1.8 ! noro 539: b = BDY((LIST)ARG0(arg)); full = (Q)ARG2(arg) ? 1 : 0;
! 540: hps = (DP *)BDY((VECT)ARG3(arg)); fprefix = BDY((STRING)ARG4(arg));
1.1 noro 541: for ( n = 0, l = b; l; l = NEXT(l), n++ );
1.8 ! noro 542: wb = (int *)ALLOCA(n*sizeof(int));
1.1 noro 543: for ( i = 0, l = b; i < n; l = NEXT(l), i++ )
544: wb[i] = QTOS((Q)BDY(l));
545: sugar = g->sugar;
546: for ( d = 0; g; ) {
547: for ( u = 0, i = 0; i < n; i++ ) {
1.8 ! noro 548: if ( dp_redble(g,hps[wb[i]]) ) {
! 549: FILE *fp;
! 550: char fname[BUFSIZ];
! 551:
! 552: sprintf(fname,"%s%d",fprefix,wb[i]);
! 553: fprintf(stderr,"loading %s\n",fname);
! 554: fp = fopen(fname,"r"); skipvl(fp);
! 555: loadobj(fp,(Obj *)&p); fclose(fp);
! 556: dp_red(d,g,p,&t,&u,&dmy,&dmy1);
1.1 noro 557: psugar = (BDY(g)->dl->td - BDY(p)->dl->td) + p->sugar;
558: sugar = MAX(sugar,psugar);
559: if ( !u ) {
560: if ( d )
561: d->sugar = sugar;
1.8 ! noro 562: *rp = d; return;
1.1 noro 563: }
1.8 ! noro 564: d = t;
1.1 noro 565: break;
566: }
567: }
568: if ( u )
569: g = u;
570: else if ( !full ) {
571: if ( g ) {
572: MKDP(g->nv,BDY(g),t); t->sugar = sugar; g = t;
573: }
1.8 ! noro 574: *rp = g; return;
1.1 noro 575: } else {
576: m = BDY(g); NEWMP(mr); mr->dl = m->dl; mr->c = m->c;
577: NEXT(mr) = 0; MKDP(g->nv,mr,t); t->sugar = mr->dl->td;
1.8 ! noro 578: addd(CO,d,t,&s); d = s;
1.1 noro 579: dp_rest(g,&t); g = t;
1.8 ! noro 580:
1.1 noro 581: }
582: }
583: if ( d )
584: d->sugar = sugar;
1.8 ! noro 585: *rp = d;
! 586: }
! 587:
! 588: void Pdp_nf_mod(arg,rp)
! 589: NODE arg;
! 590: DP *rp;
! 591: {
! 592: NODE b;
! 593: DP g;
! 594: DP *ps;
! 595: int mod,full,ac;
! 596:
! 597: ac = argc(arg);
! 598: asir_assert(ARG0(arg),O_LIST,"dp_nf_mod");
! 599: asir_assert(ARG1(arg),O_DP,"dp_nf_mod");
! 600: asir_assert(ARG2(arg),O_VECT,"dp_nf_mod");
! 601: asir_assert(ARG3(arg),O_N,"dp_nf_mod");
! 602: asir_assert(ARG4(arg),O_N,"dp_nf_mod");
! 603: if ( !(g = (DP)ARG1(arg)) ) {
! 604: *rp = 0; return;
! 605: }
! 606: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
! 607: full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));
! 608: dp_nf_mod_qindex(b,g,ps,mod,full,rp);
! 609: }
! 610:
! 611: void Pdp_true_nf_mod(arg,rp)
! 612: NODE arg;
! 613: LIST *rp;
! 614: {
! 615: NODE b;
! 616: DP g,nm;
! 617: P dn;
! 618: DP *ps;
! 619: int mod,full;
! 620: NODE n;
! 621:
! 622: asir_assert(ARG0(arg),O_LIST,"dp_nf_mod");
! 623: asir_assert(ARG1(arg),O_DP,"dp_nf_mod");
! 624: asir_assert(ARG2(arg),O_VECT,"dp_nf_mod");
! 625: asir_assert(ARG3(arg),O_N,"dp_nf_mod");
! 626: asir_assert(ARG4(arg),O_N,"dp_nf_mod");
! 627: if ( !(g = (DP)ARG1(arg)) ) {
! 628: nm = 0; dn = (P)ONEM;
! 629: } else {
! 630: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
! 631: full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));
! 632: dp_true_nf_mod(b,g,ps,mod,full,&nm,&dn);
! 633: }
! 634: NEWNODE(n); BDY(n) = (pointer)nm;
! 635: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn;
! 636: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
1.1 noro 637: }
638:
639: void Pdp_tdiv(arg,rp)
640: NODE arg;
641: DP *rp;
642: {
643: MP m,mr,mr0;
644: DP p;
645: Q c;
646: N d,q,r;
647: int sgn;
648:
649: asir_assert(ARG0(arg),O_DP,"dp_tdiv");
650: asir_assert(ARG1(arg),O_N,"dp_tdiv");
651: p = (DP)ARG0(arg); d = NM((Q)ARG1(arg)); sgn = SGN((Q)ARG1(arg));
652: if ( !p )
653: *rp = 0;
654: else {
655: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
656: divn(NM((Q)m->c),d,&q,&r);
657: if ( r ) {
658: *rp = 0; return;
659: } else {
660: NEXTMP(mr0,mr); NTOQ(q,SGN((Q)m->c)*sgn,c);
661: mr->c = (P)c; mr->dl = m->dl;
662: }
663: }
664: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
665: }
666: }
667:
668: void Pdp_red_coef(arg,rp)
669: NODE arg;
670: DP *rp;
671: {
672: MP m,mr,mr0;
673: P q,r;
674: DP p;
675: P mod;
676:
677: p = (DP)ARG0(arg); mod = (P)ARG1(arg);
678: asir_assert(p,O_DP,"dp_red_coef");
679: asir_assert(mod,O_P,"dp_red_coef");
680: if ( !p )
681: *rp = 0;
682: else {
683: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
684: divsrp(CO,m->c,mod,&q,&r);
685: if ( r ) {
686: NEXTMP(mr0,mr); mr->c = r; mr->dl = m->dl;
687: }
688: }
689: if ( mr0 ) {
690: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
691: } else
692: *rp = 0;
693: }
694: }
695:
696: void Pdp_redble(arg,rp)
697: NODE arg;
698: Q *rp;
699: {
700: asir_assert(ARG0(arg),O_DP,"dp_redble");
701: asir_assert(ARG1(arg),O_DP,"dp_redble");
702: if ( dp_redble((DP)ARG0(arg),(DP)ARG1(arg)) )
703: *rp = ONE;
704: else
705: *rp = 0;
706: }
707:
708: void Pdp_red_mod(arg,rp)
709: NODE arg;
710: LIST *rp;
711: {
712: DP h,r;
713: P dmy;
714: NODE n;
715:
716: asir_assert(ARG0(arg),O_DP,"dp_red_mod");
717: asir_assert(ARG1(arg),O_DP,"dp_red_mod");
718: asir_assert(ARG2(arg),O_DP,"dp_red_mod");
719: asir_assert(ARG3(arg),O_N,"dp_red_mod");
720: dp_red_mod((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),QTOS((Q)ARG3(arg)),
721: &h,&r,&dmy);
722: NEWNODE(n); BDY(n) = (pointer)h;
723: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r;
724: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
725: }
726: void Pdp_subd(arg,rp)
727: NODE arg;
728: DP *rp;
729: {
730: DP p1,p2;
731:
732: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
733: asir_assert(p1,O_DP,"dp_subd");
734: asir_assert(p2,O_DP,"dp_subd");
735: dp_subd(p1,p2,rp);
736: }
737:
738: void Pdp_red(arg,rp)
739: NODE arg;
740: LIST *rp;
741: {
742: NODE n;
1.4 noro 743: DP head,rest,dmy1;
1.1 noro 744: P dmy;
745:
746: asir_assert(ARG0(arg),O_DP,"dp_red");
747: asir_assert(ARG1(arg),O_DP,"dp_red");
748: asir_assert(ARG2(arg),O_DP,"dp_red");
1.4 noro 749: dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1);
1.1 noro 750: NEWNODE(n); BDY(n) = (pointer)head;
751: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest;
752: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
753: }
754:
755: void Pdp_sp(arg,rp)
756: NODE arg;
757: DP *rp;
758: {
759: DP p1,p2;
760:
761: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
762: asir_assert(p1,O_DP,"dp_sp"); asir_assert(p2,O_DP,"dp_sp");
763: dp_sp(p1,p2,rp);
764: }
765:
766: void Pdp_sp_mod(arg,rp)
767: NODE arg;
768: DP *rp;
769: {
770: DP p1,p2;
771: int mod;
772:
773: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
774: asir_assert(p1,O_DP,"dp_sp_mod"); asir_assert(p2,O_DP,"dp_sp_mod");
775: asir_assert(ARG2(arg),O_N,"dp_sp_mod");
776: mod = QTOS((Q)ARG2(arg));
777: dp_sp_mod(p1,p2,mod,rp);
778: }
779:
780: void Pdp_lcm(arg,rp)
781: NODE arg;
782: DP *rp;
783: {
784: int i,n,td;
785: DL d1,d2,d;
786: MP m;
787: DP p1,p2;
788:
789: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
790: asir_assert(p1,O_DP,"dp_lcm"); asir_assert(p2,O_DP,"dp_lcm");
791: n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl;
792: NEWDL(d,n);
793: for ( i = 0, td = 0; i < n; i++ ) {
794: d->d[i] = MAX(d1->d[i],d2->d[i]); td += d->d[i];
795: }
796: d->td = td;
797: NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0;
798: MKDP(n,m,*rp); (*rp)->sugar = td; /* XXX */
799: }
800:
801: void Pdp_hm(arg,rp)
802: NODE arg;
803: DP *rp;
804: {
805: DP p;
806:
807: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_hm");
808: dp_hm(p,rp);
809: }
810:
811: void Pdp_ht(arg,rp)
812: NODE arg;
813: DP *rp;
814: {
815: DP p;
816: MP m,mr;
817:
818: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_ht");
819: if ( !p )
820: *rp = 0;
821: else {
822: m = BDY(p);
823: NEWMP(mr); mr->dl = m->dl; mr->c = (P)ONE; NEXT(mr) = 0;
824: MKDP(p->nv,mr,*rp); (*rp)->sugar = mr->dl->td; /* XXX */
825: }
826: }
827:
828: void Pdp_hc(arg,rp)
829: NODE arg;
830: P *rp;
831: {
832: asir_assert(ARG0(arg),O_DP,"dp_hc");
833: if ( !ARG0(arg) )
834: *rp = 0;
835: else
836: *rp = BDY((DP)ARG0(arg))->c;
837: }
838:
839: void Pdp_rest(arg,rp)
840: NODE arg;
841: DP *rp;
842: {
843: asir_assert(ARG0(arg),O_DP,"dp_rest");
844: if ( !ARG0(arg) )
845: *rp = 0;
846: else
847: dp_rest((DP)ARG0(arg),rp);
848: }
849:
850: void Pdp_td(arg,rp)
851: NODE arg;
852: Q *rp;
853: {
854: DP p;
855:
856: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_td");
857: if ( !p )
858: *rp = 0;
859: else
860: STOQ(BDY(p)->dl->td,*rp);
861: }
862:
863: void Pdp_sugar(arg,rp)
864: NODE arg;
865: Q *rp;
866: {
867: DP p;
868:
869: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_sugar");
870: if ( !p )
871: *rp = 0;
872: else
873: STOQ(p->sugar,*rp);
874: }
875:
876: void Pdp_cri1(arg,rp)
877: NODE arg;
878: Q *rp;
879: {
880: DP p1,p2;
881: int *d1,*d2;
882: int i,n;
883:
884: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
885: asir_assert(p1,O_DP,"dp_cri1"); asir_assert(p2,O_DP,"dp_cri1");
886: n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d;
887: for ( i = 0; i < n; i++ )
888: if ( d1[i] > d2[i] )
889: break;
890: *rp = i == n ? ONE : 0;
891: }
892:
893: void Pdp_cri2(arg,rp)
894: NODE arg;
895: Q *rp;
896: {
897: DP p1,p2;
898: int *d1,*d2;
899: int i,n;
900:
901: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
902: asir_assert(p1,O_DP,"dp_cri2"); asir_assert(p2,O_DP,"dp_cri2");
903: n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d;
904: for ( i = 0; i < n; i++ )
905: if ( MIN(d1[i],d2[i]) >= 1 )
906: break;
907: *rp = i == n ? ONE : 0;
908: }
909:
910: void Pdp_minp(arg,rp)
911: NODE arg;
912: LIST *rp;
913: {
914: NODE tn,tn1,d,dd,dd0,p,tp;
915: LIST l,minp;
916: DP lcm,tlcm;
917: int s,ts;
918:
919: asir_assert(ARG0(arg),O_LIST,"dp_minp");
920: d = BDY((LIST)ARG0(arg)); minp = (LIST)BDY(d);
921: p = BDY(minp); p = NEXT(NEXT(p)); lcm = (DP)BDY(p); p = NEXT(p);
922: if ( !ARG1(arg) ) {
923: s = QTOS((Q)BDY(p)); p = NEXT(p);
924: for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) {
925: tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp));
926: tlcm = (DP)BDY(tp); tp = NEXT(tp);
927: ts = QTOS((Q)BDY(tp)); tp = NEXT(tp);
928: NEXTNODE(dd0,dd);
929: if ( ts < s ) {
930: BDY(dd) = (pointer)minp;
931: minp = (LIST)BDY(d); lcm = tlcm; s = ts;
932: } else if ( ts == s ) {
933: if ( compd(CO,lcm,tlcm) > 0 ) {
934: BDY(dd) = (pointer)minp;
935: minp = (LIST)BDY(d); lcm = tlcm; s = ts;
936: } else
937: BDY(dd) = BDY(d);
938: } else
939: BDY(dd) = BDY(d);
940: }
941: } else {
942: for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) {
943: tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp));
944: tlcm = (DP)BDY(tp);
945: NEXTNODE(dd0,dd);
946: if ( compd(CO,lcm,tlcm) > 0 ) {
947: BDY(dd) = (pointer)minp; minp = (LIST)BDY(d); lcm = tlcm;
948: } else
949: BDY(dd) = BDY(d);
950: }
951: }
952: if ( dd0 )
953: NEXT(dd) = 0;
954: MKLIST(l,dd0); MKNODE(tn,l,0); MKNODE(tn1,minp,tn); MKLIST(*rp,tn1);
955: }
956:
957: void Pdp_criB(arg,rp)
958: NODE arg;
959: LIST *rp;
960: {
961: NODE d,ij,dd,ddd;
962: int i,j,s,n;
963: DP *ps;
964: DL ts,ti,tj,lij,tdl;
965:
966: asir_assert(ARG0(arg),O_LIST,"dp_criB"); d = BDY((LIST)ARG0(arg));
967: asir_assert(ARG1(arg),O_N,"dp_criB"); s = QTOS((Q)ARG1(arg));
968: asir_assert(ARG2(arg),O_VECT,"dp_criB"); ps = (DP *)BDY((VECT)ARG2(arg));
969: if ( !d )
970: *rp = (LIST)ARG0(arg);
971: else {
972: ts = BDY(ps[s])->dl;
973: n = ps[s]->nv;
974: NEWDL(tdl,n);
975: for ( dd = 0; d; d = NEXT(d) ) {
976: ij = BDY((LIST)BDY(d));
977: i = QTOS((Q)BDY(ij)); ij = NEXT(ij);
978: j = QTOS((Q)BDY(ij)); ij = NEXT(ij);
979: lij = BDY((DP)BDY(ij))->dl;
980: ti = BDY(ps[i])->dl; tj = BDY(ps[j])->dl;
981: if ( lij->td != lcm_of_DL(n,lij,ts,tdl)->td
982: || !dl_equal(n,lij,tdl)
983: || (lij->td == lcm_of_DL(n,ti,ts,tdl)->td
984: && dl_equal(n,tdl,lij))
985: || (lij->td == lcm_of_DL(n,tj,ts,tdl)->td
986: && dl_equal(n,tdl,lij)) ) {
987: MKNODE(ddd,BDY(d),dd);
988: dd = ddd;
989: }
990: }
991: MKLIST(*rp,dd);
992: }
993: }
994:
995: void Pdp_nelim(arg,rp)
996: NODE arg;
997: Q *rp;
998: {
999: if ( arg ) {
1000: asir_assert(ARG0(arg),O_N,"dp_nelim");
1001: dp_nelim = QTOS((Q)ARG0(arg));
1002: }
1003: STOQ(dp_nelim,*rp);
1004: }
1005:
1006: void Pdp_mag(arg,rp)
1007: NODE arg;
1008: Q *rp;
1009: {
1010: DP p;
1011: int s;
1012: MP m;
1013:
1014: p = (DP)ARG0(arg);
1015: asir_assert(p,O_DP,"dp_mag");
1016: if ( !p )
1017: *rp = 0;
1018: else {
1019: for ( s = 0, m = BDY(p); m; m = NEXT(m) )
1020: s += p_mag(m->c);
1021: STOQ(s,*rp);
1022: }
1023: }
1024:
1025: extern int kara_mag;
1026:
1027: void Pdp_set_kara(arg,rp)
1028: NODE arg;
1029: Q *rp;
1030: {
1031: if ( arg ) {
1032: asir_assert(ARG0(arg),O_N,"dp_set_kara");
1033: kara_mag = QTOS((Q)ARG0(arg));
1034: }
1035: STOQ(kara_mag,*rp);
1036: }
1037:
1038: void Pdp_homo(arg,rp)
1039: NODE arg;
1040: DP *rp;
1041: {
1042: asir_assert(ARG0(arg),O_DP,"dp_homo");
1043: dp_homo((DP)ARG0(arg),rp);
1044: }
1045:
1.8 ! noro 1046: void Pdp_dehomo(arg,rp)
! 1047: NODE arg;
1.1 noro 1048: DP *rp;
1049: {
1.8 ! noro 1050: asir_assert(ARG0(arg),O_DP,"dp_dehomo");
! 1051: dp_dehomo((DP)ARG0(arg),rp);
! 1052: }
! 1053:
! 1054: void Pdp_gr_flags(arg,rp)
! 1055: NODE arg;
! 1056: LIST *rp;
! 1057: {
! 1058: Obj name,value;
! 1059: NODE n;
1.1 noro 1060:
1.8 ! noro 1061: if ( arg ) {
! 1062: asir_assert(ARG0(arg),O_LIST,"dp_gr_flags");
! 1063: n = BDY((LIST)ARG0(arg));
! 1064: while ( n ) {
! 1065: name = (Obj)BDY(n); n = NEXT(n);
! 1066: if ( !n )
! 1067: break;
! 1068: else {
! 1069: value = (Obj)BDY(n); n = NEXT(n);
! 1070: }
! 1071: dp_set_flag(name,value);
1.1 noro 1072: }
1073: }
1.8 ! noro 1074: dp_make_flaglist(rp);
! 1075: }
! 1076:
! 1077: extern int DP_Print;
! 1078:
! 1079: void Pdp_gr_print(arg,rp)
! 1080: NODE arg;
! 1081: Q *rp;
! 1082: {
! 1083: Q q;
! 1084:
! 1085: if ( arg ) {
! 1086: asir_assert(ARG0(arg),O_N,"dp_gr_print");
! 1087: q = (Q)ARG0(arg); DP_Print = QTOS(q);
! 1088: } else
! 1089: STOQ(DP_Print,q);
! 1090: *rp = q;
1.1 noro 1091: }
1092:
1.8 ! noro 1093: void Pdp_gr_main(arg,rp)
1.1 noro 1094: NODE arg;
1.8 ! noro 1095: LIST *rp;
1.1 noro 1096: {
1.8 ! noro 1097: LIST f,v;
! 1098: Num homo;
! 1099: Q m;
! 1100: int modular;
! 1101: struct order_spec ord;
! 1102:
! 1103: asir_assert(ARG0(arg),O_LIST,"dp_gr_main");
! 1104: asir_assert(ARG1(arg),O_LIST,"dp_gr_main");
! 1105: asir_assert(ARG2(arg),O_N,"dp_gr_main");
! 1106: asir_assert(ARG3(arg),O_N,"dp_gr_main");
! 1107: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
! 1108: homo = (Num)ARG2(arg);
! 1109: m = (Q)ARG3(arg);
! 1110: if ( !m )
! 1111: modular = 0;
! 1112: else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) )
! 1113: error("dp_gr_main : too large modulus");
! 1114: else
! 1115: modular = QTOS(m);
! 1116: create_order_spec(ARG4(arg),&ord);
! 1117: dp_gr_main(f,v,homo,modular,&ord,rp);
1.1 noro 1118: }
1119:
1.8 ! noro 1120: void Pdp_f4_main(arg,rp)
! 1121: NODE arg;
! 1122: LIST *rp;
1.1 noro 1123: {
1.8 ! noro 1124: LIST f,v;
! 1125: struct order_spec ord;
1.1 noro 1126:
1.8 ! noro 1127: asir_assert(ARG0(arg),O_LIST,"dp_f4_main");
! 1128: asir_assert(ARG1(arg),O_LIST,"dp_f4_main");
! 1129: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
! 1130: create_order_spec(ARG2(arg),&ord);
! 1131: dp_f4_main(f,v,&ord,rp);
1.1 noro 1132: }
1133:
1.8 ! noro 1134: void Pdp_f4_mod_main(arg,rp)
! 1135: NODE arg;
! 1136: LIST *rp;
1.1 noro 1137: {
1.8 ! noro 1138: LIST f,v;
! 1139: int m;
! 1140: struct order_spec ord;
! 1141:
! 1142: asir_assert(ARG0(arg),O_LIST,"dp_f4_main");
! 1143: asir_assert(ARG1(arg),O_LIST,"dp_f4_main");
! 1144: asir_assert(ARG2(arg),O_N,"dp_f4_main");
! 1145: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg));
! 1146: create_order_spec(ARG3(arg),&ord);
! 1147: dp_f4_mod_main(f,v,m,&ord,rp);
! 1148: }
1.1 noro 1149:
1.8 ! noro 1150: void Pdp_gr_mod_main(arg,rp)
! 1151: NODE arg;
! 1152: LIST *rp;
! 1153: {
! 1154: LIST f,v;
! 1155: Num homo;
! 1156: int m;
! 1157: struct order_spec ord;
! 1158:
! 1159: asir_assert(ARG0(arg),O_LIST,"dp_gr_mod_main");
! 1160: asir_assert(ARG1(arg),O_LIST,"dp_gr_mod_main");
! 1161: asir_assert(ARG2(arg),O_N,"dp_gr_mod_main");
! 1162: asir_assert(ARG3(arg),O_N,"dp_gr_mod_main");
! 1163: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
! 1164: homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg));
! 1165: create_order_spec(ARG4(arg),&ord);
! 1166: dp_gr_mod_main(f,v,homo,m,&ord,rp);
1.1 noro 1167: }
1.8 ! noro 1168:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[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