[BACK]Return to dp.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Annotation of OpenXM_contrib2/asir2000/builtin/dp.c, Revision 1.16

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.16    ! noro       48:  * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.15 2001/01/11 08:43:21 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.11      noro       60: int do_weyl;
1.1       noro       61:
                     62: void Pdp_ord(), Pdp_ptod(), Pdp_dtop();
                     63: void Pdp_ptozp(), Pdp_ptozp2(), Pdp_red(), Pdp_red2(), Pdp_lcm(), Pdp_redble();
                     64: void Pdp_sp(), Pdp_hm(), Pdp_ht(), Pdp_hc(), Pdp_rest(), Pdp_td(), Pdp_sugar();
                     65: void Pdp_cri1(),Pdp_cri2(),Pdp_subd(),Pdp_mod(),Pdp_red_mod(),Pdp_tdiv();
                     66: void Pdp_prim(),Pdp_red_coef(),Pdp_mag(),Pdp_set_kara(),Pdp_rat();
1.9       noro       67: void Pdp_nf(),Pdp_true_nf();
1.1       noro       68: void Pdp_nf_mod(),Pdp_true_nf_mod();
                     69: void Pdp_criB(),Pdp_nelim();
1.9       noro       70: void Pdp_minp(),Pdp_sp_mod();
1.1       noro       71: void Pdp_homo(),Pdp_dehomo();
1.16    ! noro       72: void Pdp_gr_mod_main(),Pdp_gr_f_main();
1.1       noro       73: void Pdp_gr_main(),Pdp_gr_hm_main(),Pdp_gr_d_main(),Pdp_gr_flags();
1.16    ! noro       74: void Pdp_f4_main(),Pdp_f4_mod_main(),Pdp_f4_f_main();
1.1       noro       75: void Pdp_gr_print();
1.8       noro       76: void Pdp_mbase(),Pdp_lnf_mod(),Pdp_nf_tab_mod(),Pdp_mdtod();
                     77: void Pdp_vtoe(), Pdp_etov(), Pdp_dtov(), Pdp_idiv(), Pdp_sep();
                     78: void Pdp_cont();
1.1       noro       79:
1.13      noro       80: void Pdp_weyl_red();
                     81: void Pdp_weyl_sp();
                     82: void Pdp_weyl_nf(),Pdp_weyl_nf_mod();
1.16    ! noro       83: void Pdp_weyl_gr_main(),Pdp_weyl_gr_mod_main(),Pdp_weyl_gr_f_main();
        !            84: void Pdp_weyl_f4_main(),Pdp_weyl_f4_mod_main(),Pdp_weyl_f4_f_main();
1.13      noro       85: void Pdp_weyl_mul(),Pdp_weyl_mul_mod();
1.15      noro       86: void Pdp_weyl_set_weight();
1.16    ! noro       87: void Pdp_nf_f(),Pdp_weyl_nf_f();
        !            88: void Pdp_lnf_f();
1.11      noro       89:
1.1       noro       90: struct ftab dp_tab[] = {
1.8       noro       91:        /* content reduction */
1.1       noro       92:        {"dp_ptozp",Pdp_ptozp,1},
                     93:        {"dp_ptozp2",Pdp_ptozp2,2},
                     94:        {"dp_prim",Pdp_prim,1},
1.8       noro       95:        {"dp_red_coef",Pdp_red_coef,2},
                     96:        {"dp_cont",Pdp_cont,1},
                     97:
1.11      noro       98: /* polynomial ring */
1.8       noro       99:        /* s-poly */
                    100:        {"dp_sp",Pdp_sp,2},
                    101:        {"dp_sp_mod",Pdp_sp_mod,3},
                    102:
                    103:        /* m-reduction */
1.1       noro      104:        {"dp_red",Pdp_red,3},
                    105:        {"dp_red_mod",Pdp_red_mod,4},
1.8       noro      106:
                    107:        /* normal form */
1.1       noro      108:        {"dp_nf",Pdp_nf,4},
1.16    ! noro      109:        {"dp_nf_f",Pdp_nf_f,4},
1.1       noro      110:        {"dp_true_nf",Pdp_true_nf,4},
                    111:        {"dp_nf_mod",Pdp_nf_mod,5},
                    112:        {"dp_true_nf_mod",Pdp_true_nf_mod,5},
1.8       noro      113:        {"dp_lnf_mod",Pdp_lnf_mod,3},
                    114:        {"dp_nf_tab_mod",Pdp_nf_tab_mod,3},
1.16    ! noro      115:        {"dp_lnf_f",Pdp_lnf_f,2},
1.8       noro      116:
                    117:        /* Buchberger algorithm */
1.1       noro      118:        {"dp_gr_main",Pdp_gr_main,5},
                    119:        {"dp_gr_mod_main",Pdp_gr_mod_main,5},
1.16    ! noro      120:        {"dp_gr_f_main",Pdp_gr_f_main,4},
1.8       noro      121:
                    122:        /* F4 algorithm */
1.1       noro      123:        {"dp_f4_main",Pdp_f4_main,3},
                    124:        {"dp_f4_mod_main",Pdp_f4_mod_main,4},
1.16    ! noro      125:        {"dp_f4_f_main",Pdp_f4_f_main,3},
1.8       noro      126:
1.11      noro      127: /* weyl algebra */
1.12      noro      128:        /* multiplication */
                    129:        {"dp_weyl_mul",Pdp_weyl_mul,2},
1.13      noro      130:        {"dp_weyl_mul_mod",Pdp_weyl_mul_mod,3},
1.12      noro      131:
1.11      noro      132:        /* s-poly */
                    133:        {"dp_weyl_sp",Pdp_weyl_sp,2},
                    134:
                    135:        /* m-reduction */
                    136:        {"dp_weyl_red",Pdp_weyl_red,3},
                    137:
                    138:        /* normal form */
                    139:        {"dp_weyl_nf",Pdp_weyl_nf,4},
1.13      noro      140:        {"dp_weyl_nf_mod",Pdp_weyl_nf_mod,5},
1.16    ! noro      141:        {"dp_weyl_nf_f",Pdp_weyl_nf_f,4},
1.11      noro      142:
                    143:        /* Buchberger algorithm */
                    144:        {"dp_weyl_gr_main",Pdp_weyl_gr_main,5},
                    145:        {"dp_weyl_gr_mod_main",Pdp_weyl_gr_mod_main,5},
1.16    ! noro      146:        {"dp_weyl_gr_f_main",Pdp_weyl_gr_f_main,4},
1.11      noro      147:
                    148:        /* F4 algorithm */
                    149:        {"dp_weyl_f4_main",Pdp_weyl_f4_main,3},
                    150:        {"dp_weyl_f4_mod_main",Pdp_weyl_f4_mod_main,4},
1.16    ! noro      151:        {"dp_weyl_f4_f_main",Pdp_weyl_f4_f_main,3},
1.11      noro      152:
1.15      noro      153:        /* misc */
                    154:        {"dp_weyl_set_weight",Pdp_weyl_set_weight,-1},
1.8       noro      155:        {0,0,0},
                    156: };
                    157:
                    158: struct ftab dp_supp_tab[] = {
                    159:        /* setting flags */
                    160:        {"dp_ord",Pdp_ord,-1},
                    161:        {"dp_set_kara",Pdp_set_kara,-1},
                    162:        {"dp_nelim",Pdp_nelim,-1},
1.1       noro      163:        {"dp_gr_flags",Pdp_gr_flags,-1},
                    164:        {"dp_gr_print",Pdp_gr_print,-1},
1.8       noro      165:
                    166:        /* converters */
                    167:        {"dp_ptod",Pdp_ptod,2},
                    168:        {"dp_dtop",Pdp_dtop,2},
                    169:        {"dp_homo",Pdp_homo,1},
                    170:        {"dp_dehomo",Pdp_dehomo,1},
                    171:        {"dp_etov",Pdp_etov,1},
                    172:        {"dp_vtoe",Pdp_vtoe,1},
                    173:        {"dp_dtov",Pdp_dtov,1},
                    174:        {"dp_mdtod",Pdp_mdtod,1},
                    175:        {"dp_mod",Pdp_mod,3},
                    176:        {"dp_rat",Pdp_rat,1},
                    177:
                    178:        /* criteria */
                    179:        {"dp_cri1",Pdp_cri1,2},
                    180:        {"dp_cri2",Pdp_cri2,2},
                    181:        {"dp_criB",Pdp_criB,3},
                    182:
                    183:        /* simple operation */
                    184:        {"dp_subd",Pdp_subd,2},
                    185:        {"dp_lcm",Pdp_lcm,2},
                    186:        {"dp_hm",Pdp_hm,1},
                    187:        {"dp_ht",Pdp_ht,1},
                    188:        {"dp_hc",Pdp_hc,1},
                    189:        {"dp_rest",Pdp_rest,1},
                    190:
                    191:        /* degree and size */
                    192:        {"dp_td",Pdp_td,1},
                    193:        {"dp_mag",Pdp_mag,1},
                    194:        {"dp_sugar",Pdp_sugar,1},
                    195:
                    196:        /* misc */
                    197:        {"dp_mbase",Pdp_mbase,1},
                    198:        {"dp_redble",Pdp_redble,2},
                    199:        {"dp_sep",Pdp_sep,2},
                    200:        {"dp_idiv",Pdp_idiv,2},
                    201:        {"dp_tdiv",Pdp_tdiv,2},
                    202:        {"dp_minp",Pdp_minp,2},
                    203:
                    204:        {0,0,0}
1.1       noro      205: };
                    206:
1.8       noro      207: void Pdp_mdtod(arg,rp)
                    208: NODE arg;
                    209: DP *rp;
                    210: {
                    211:        MP m,mr,mr0;
                    212:        DP p;
                    213:        P t;
                    214:
                    215:        p = (DP)ARG0(arg);
                    216:        if ( !p )
                    217:                *rp = 0;
                    218:        else {
                    219:                for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
                    220:                        mptop(m->c,&t); NEXTMP(mr0,mr); mr->c = t; mr->dl = m->dl;
                    221:                }
                    222:                NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
                    223:        }
                    224: }
                    225:
                    226: void Pdp_sep(arg,rp)
                    227: NODE arg;
                    228: VECT *rp;
                    229: {
                    230:        DP p,r;
                    231:        MP m,t;
                    232:        MP *w0,*w;
                    233:        int i,n,d,nv,sugar;
                    234:        VECT v;
                    235:        pointer *pv;
                    236:
                    237:        p = (DP)ARG0(arg); m = BDY(p);
                    238:        d = QTOS((Q)ARG1(arg));
                    239:        for ( t = m, n = 0; t; t = NEXT(t), n++ );
                    240:        if ( d > n )
                    241:                d = n;
                    242:        MKVECT(v,d); *rp = v;
                    243:        pv = BDY(v); nv = p->nv; sugar = p->sugar;
                    244:        w0 = (MP *)MALLOC(d*sizeof(MP)); bzero(w0,d*sizeof(MP));
                    245:        w = (MP *)MALLOC(d*sizeof(MP)); bzero(w,d*sizeof(MP));
                    246:        for ( t = BDY(p), i = 0; t; t = NEXT(t), i++, i %= d  ) {
                    247:                NEXTMP(w0[i],w[i]); w[i]->c = t->c; w[i]->dl = t->dl;
                    248:        }
                    249:        for ( i = 0; i < d; i++ ) {
                    250:                NEXT(w[i]) = 0; MKDP(nv,w0[i],r); r->sugar = sugar;
                    251:                pv[i] = (pointer)r;
                    252:        }
                    253: }
                    254:
                    255: void Pdp_idiv(arg,rp)
                    256: NODE arg;
                    257: DP *rp;
                    258: {
                    259:        dp_idiv((DP)ARG0(arg),(Q)ARG1(arg),rp);
                    260: }
                    261:
                    262: void Pdp_cont(arg,rp)
                    263: NODE arg;
                    264: Q *rp;
                    265: {
                    266:        dp_cont((DP)ARG0(arg),rp);
                    267: }
                    268:
                    269: void Pdp_dtov(arg,rp)
                    270: NODE arg;
                    271: VECT *rp;
                    272: {
                    273:        dp_dtov((DP)ARG0(arg),rp);
                    274: }
                    275:
                    276: void Pdp_mbase(arg,rp)
                    277: NODE arg;
                    278: LIST *rp;
                    279: {
                    280:        NODE mb;
                    281:
                    282:        asir_assert(ARG0(arg),O_LIST,"dp_mbase");
                    283:        dp_mbase(BDY((LIST)ARG0(arg)),&mb);
                    284:        MKLIST(*rp,mb);
                    285: }
                    286:
                    287: void Pdp_etov(arg,rp)
                    288: NODE arg;
                    289: VECT *rp;
                    290: {
                    291:        DP dp;
                    292:        int n,i;
                    293:        int *d;
                    294:        VECT v;
                    295:        Q t;
                    296:
                    297:        dp = (DP)ARG0(arg);
                    298:        asir_assert(dp,O_DP,"dp_etov");
                    299:        n = dp->nv; d = BDY(dp)->dl->d;
                    300:        MKVECT(v,n);
                    301:        for ( i = 0; i < n; i++ ) {
                    302:                STOQ(d[i],t); v->body[i] = (pointer)t;
                    303:        }
                    304:        *rp = v;
                    305: }
                    306:
                    307: void Pdp_vtoe(arg,rp)
                    308: NODE arg;
                    309: DP *rp;
                    310: {
                    311:        DP dp;
                    312:        DL dl;
                    313:        MP m;
                    314:        int n,i,td;
                    315:        int *d;
                    316:        VECT v;
                    317:
                    318:        v = (VECT)ARG0(arg);
                    319:        asir_assert(v,O_VECT,"dp_vtoe");
                    320:        n = v->len;
                    321:        NEWDL(dl,n); d = dl->d;
                    322:        for ( i = 0, td = 0; i < n; i++ ) {
                    323:                d[i] = QTOS((Q)(v->body[i])); td += d[i];
                    324:        }
                    325:        dl->td = td;
                    326:        NEWMP(m); m->dl = dl; m->c = (P)ONE; NEXT(m) = 0;
                    327:        MKDP(n,m,dp); dp->sugar = td;
                    328:        *rp = dp;
                    329: }
                    330:
                    331: void Pdp_lnf_mod(arg,rp)
                    332: NODE arg;
                    333: LIST *rp;
                    334: {
                    335:        DP r1,r2;
                    336:        NODE b,g,n;
                    337:        int mod;
                    338:
                    339:        asir_assert(ARG0(arg),O_LIST,"dp_lnf_mod");
                    340:        asir_assert(ARG1(arg),O_LIST,"dp_lnf_mod");
                    341:        asir_assert(ARG2(arg),O_N,"dp_lnf_mod");
                    342:        b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg));
                    343:        mod = QTOS((Q)ARG2(arg));
                    344:        dp_lnf_mod((DP)BDY(b),(DP)BDY(NEXT(b)),g,mod,&r1,&r2);
                    345:        NEWNODE(n); BDY(n) = (pointer)r1;
                    346:        NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2;
                    347:        NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
                    348: }
                    349:
1.16    ! noro      350: void Pdp_lnf_f(arg,rp)
        !           351: NODE arg;
        !           352: LIST *rp;
        !           353: {
        !           354:        DP r1,r2;
        !           355:        NODE b,g,n;
        !           356:
        !           357:        asir_assert(ARG0(arg),O_LIST,"dp_lnf_f");
        !           358:        asir_assert(ARG1(arg),O_LIST,"dp_lnf_f");
        !           359:        b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg));
        !           360:        dp_lnf_f((DP)BDY(b),(DP)BDY(NEXT(b)),g,&r1,&r2);
        !           361:        NEWNODE(n); BDY(n) = (pointer)r1;
        !           362:        NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2;
        !           363:        NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
        !           364: }
        !           365:
1.8       noro      366: void Pdp_nf_tab_mod(arg,rp)
                    367: NODE arg;
                    368: DP *rp;
                    369: {
                    370:        asir_assert(ARG0(arg),O_DP,"dp_nf_tab_mod");
                    371:        asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_mod");
                    372:        asir_assert(ARG2(arg),O_N,"dp_nf_tab_mod");
                    373:        dp_nf_tab_mod((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)),
                    374:                QTOS((Q)ARG2(arg)),rp);
                    375: }
1.1       noro      376:
                    377: void Pdp_ord(arg,rp)
                    378: NODE arg;
                    379: Obj *rp;
                    380: {
                    381:        struct order_spec spec;
                    382:
                    383:        if ( !arg )
                    384:                *rp = dp_current_spec.obj;
                    385:        else if ( !create_order_spec((Obj)ARG0(arg),&spec) )
                    386:                error("dp_ord : invalid order specification");
                    387:        else {
                    388:                initd(&spec); *rp = spec.obj;
                    389:        }
                    390: }
                    391:
                    392: void Pdp_ptod(arg,rp)
                    393: NODE arg;
                    394: DP *rp;
                    395: {
                    396:        NODE n;
                    397:        VL vl,tvl;
                    398:
                    399:        asir_assert(ARG0(arg),O_P,"dp_ptod");
                    400:        asir_assert(ARG1(arg),O_LIST,"dp_ptod");
                    401:        for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {
                    402:                if ( !vl ) {
                    403:                        NEWVL(vl); tvl = vl;
                    404:                } else {
                    405:                        NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
                    406:                }
                    407:                VR(tvl) = VR((P)BDY(n));
                    408:        }
                    409:        if ( vl )
                    410:                NEXT(tvl) = 0;
                    411:        ptod(CO,vl,(P)ARG0(arg),rp);
                    412: }
                    413:
                    414: void Pdp_dtop(arg,rp)
                    415: NODE arg;
                    416: P *rp;
                    417: {
                    418:        NODE n;
                    419:        VL vl,tvl;
                    420:
                    421:        asir_assert(ARG0(arg),O_DP,"dp_dtop");
                    422:        asir_assert(ARG1(arg),O_LIST,"dp_dtop");
                    423:        for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {
                    424:                if ( !vl ) {
                    425:                        NEWVL(vl); tvl = vl;
                    426:                } else {
                    427:                        NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
                    428:                }
                    429:                VR(tvl) = VR((P)BDY(n));
                    430:        }
                    431:        if ( vl )
                    432:                NEXT(tvl) = 0;
                    433:        dtop(CO,vl,(DP)ARG0(arg),rp);
                    434: }
                    435:
                    436: extern LIST Dist;
                    437:
                    438: void Pdp_ptozp(arg,rp)
                    439: NODE arg;
                    440: DP *rp;
                    441: {
                    442:        asir_assert(ARG0(arg),O_DP,"dp_ptozp");
1.10      noro      443:        dp_ptozp((DP)ARG0(arg),rp);
1.1       noro      444: }
                    445:
                    446: void Pdp_ptozp2(arg,rp)
                    447: NODE arg;
                    448: LIST *rp;
                    449: {
                    450:        DP p0,p1,h,r;
                    451:        NODE n0;
                    452:
                    453:        p0 = (DP)ARG0(arg); p1 = (DP)ARG1(arg);
                    454:        asir_assert(p0,O_DP,"dp_ptozp2");
                    455:        asir_assert(p1,O_DP,"dp_ptozp2");
1.10      noro      456:        dp_ptozp2(p0,p1,&h,&r);
1.1       noro      457:        NEWNODE(n0); BDY(n0) = (pointer)h;
                    458:        NEWNODE(NEXT(n0)); BDY(NEXT(n0)) = (pointer)r;
                    459:        NEXT(NEXT(n0)) = 0;
                    460:        MKLIST(*rp,n0);
                    461: }
                    462:
                    463: void Pdp_prim(arg,rp)
                    464: NODE arg;
                    465: DP *rp;
                    466: {
                    467:        DP t;
                    468:
                    469:        asir_assert(ARG0(arg),O_DP,"dp_prim");
                    470:        dp_prim((DP)ARG0(arg),&t); dp_ptozp(t,rp);
                    471: }
                    472:
                    473: void Pdp_mod(arg,rp)
                    474: NODE arg;
                    475: DP *rp;
                    476: {
                    477:        DP p;
                    478:        int mod;
                    479:        NODE subst;
                    480:
                    481:        asir_assert(ARG0(arg),O_DP,"dp_mod");
                    482:        asir_assert(ARG1(arg),O_N,"dp_mod");
                    483:        asir_assert(ARG2(arg),O_LIST,"dp_mod");
                    484:        p = (DP)ARG0(arg); mod = QTOS((Q)ARG1(arg));
                    485:        subst = BDY((LIST)ARG2(arg));
                    486:        dp_mod(p,mod,subst,rp);
                    487: }
                    488:
                    489: void Pdp_rat(arg,rp)
                    490: NODE arg;
                    491: DP *rp;
                    492: {
                    493:        asir_assert(ARG0(arg),O_DP,"dp_rat");
                    494:        dp_rat((DP)ARG0(arg),rp);
                    495: }
                    496:
1.9       noro      497: extern int DP_Multiple;
                    498:
1.1       noro      499: void Pdp_nf(arg,rp)
                    500: NODE arg;
                    501: DP *rp;
                    502: {
                    503:        NODE b;
                    504:        DP *ps;
                    505:        DP g;
                    506:        int full;
                    507:
1.11      noro      508:        do_weyl = 0;
1.1       noro      509:        asir_assert(ARG0(arg),O_LIST,"dp_nf");
                    510:        asir_assert(ARG1(arg),O_DP,"dp_nf");
                    511:        asir_assert(ARG2(arg),O_VECT,"dp_nf");
                    512:        asir_assert(ARG3(arg),O_N,"dp_nf");
                    513:        if ( !(g = (DP)ARG1(arg)) ) {
                    514:                *rp = 0; return;
                    515:        }
                    516:        b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
                    517:        full = (Q)ARG3(arg) ? 1 : 0;
1.16    ! noro      518:        dp_nf_z(b,g,ps,full,DP_Multiple,rp);
1.1       noro      519: }
                    520:
1.11      noro      521: void Pdp_weyl_nf(arg,rp)
                    522: NODE arg;
                    523: DP *rp;
                    524: {
                    525:        NODE b;
                    526:        DP *ps;
                    527:        DP g;
                    528:        int full;
                    529:
                    530:        asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf");
                    531:        asir_assert(ARG1(arg),O_DP,"dp_weyl_nf");
                    532:        asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf");
                    533:        asir_assert(ARG3(arg),O_N,"dp_weyl_nf");
                    534:        if ( !(g = (DP)ARG1(arg)) ) {
                    535:                *rp = 0; return;
                    536:        }
                    537:        b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
                    538:        full = (Q)ARG3(arg) ? 1 : 0;
1.12      noro      539:        do_weyl = 1;
1.16    ! noro      540:        dp_nf_z(b,g,ps,full,DP_Multiple,rp);
        !           541:        do_weyl = 0;
        !           542: }
        !           543:
        !           544: /* nf computation using field operations */
        !           545:
        !           546: void Pdp_nf_f(arg,rp)
        !           547: NODE arg;
        !           548: DP *rp;
        !           549: {
        !           550:        NODE b;
        !           551:        DP *ps;
        !           552:        DP g;
        !           553:        int full;
        !           554:
        !           555:        do_weyl = 0;
        !           556:        asir_assert(ARG0(arg),O_LIST,"dp_nf_f");
        !           557:        asir_assert(ARG1(arg),O_DP,"dp_nf_f");
        !           558:        asir_assert(ARG2(arg),O_VECT,"dp_nf_f");
        !           559:        asir_assert(ARG3(arg),O_N,"dp_nf_f");
        !           560:        if ( !(g = (DP)ARG1(arg)) ) {
        !           561:                *rp = 0; return;
        !           562:        }
        !           563:        b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
        !           564:        full = (Q)ARG3(arg) ? 1 : 0;
        !           565:        dp_nf_f(b,g,ps,full,rp);
        !           566: }
        !           567:
        !           568: void Pdp_weyl_nf_f(arg,rp)
        !           569: NODE arg;
        !           570: DP *rp;
        !           571: {
        !           572:        NODE b;
        !           573:        DP *ps;
        !           574:        DP g;
        !           575:        int full;
        !           576:
        !           577:        asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_f");
        !           578:        asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_f");
        !           579:        asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_f");
        !           580:        asir_assert(ARG3(arg),O_N,"dp_weyl_nf_f");
        !           581:        if ( !(g = (DP)ARG1(arg)) ) {
        !           582:                *rp = 0; return;
        !           583:        }
        !           584:        b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
        !           585:        full = (Q)ARG3(arg) ? 1 : 0;
        !           586:        do_weyl = 1;
        !           587:        dp_nf_f(b,g,ps,full,rp);
1.12      noro      588:        do_weyl = 0;
1.11      noro      589: }
                    590:
1.13      noro      591: void Pdp_nf_mod(arg,rp)
                    592: NODE arg;
                    593: DP *rp;
                    594: {
                    595:        NODE b;
                    596:        DP g;
                    597:        DP *ps;
                    598:        int mod,full,ac;
                    599:        NODE n,n0;
                    600:
1.14      noro      601:        do_weyl = 0;
1.13      noro      602:        ac = argc(arg);
1.14      noro      603:        asir_assert(ARG0(arg),O_LIST,"dp_nf_mod");
                    604:        asir_assert(ARG1(arg),O_DP,"dp_nf_mod");
                    605:        asir_assert(ARG2(arg),O_VECT,"dp_nf_mod");
                    606:        asir_assert(ARG3(arg),O_N,"dp_nf_mod");
                    607:        asir_assert(ARG4(arg),O_N,"dp_nf_mod");
1.13      noro      608:        if ( !(g = (DP)ARG1(arg)) ) {
                    609:                *rp = 0; return;
                    610:        }
                    611:        b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
                    612:        full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));
                    613:        for ( n0 = n = 0; b; b = NEXT(b) ) {
                    614:                NEXTNODE(n0,n);
                    615:                BDY(n) = (pointer)QTOS((Q)BDY(b));
                    616:        }
                    617:        if ( n0 )
                    618:                NEXT(n) = 0;
                    619:        dp_nf_mod(n0,g,ps,mod,full,rp);
                    620: }
                    621:
1.1       noro      622: void Pdp_true_nf(arg,rp)
                    623: NODE arg;
                    624: LIST *rp;
                    625: {
                    626:        NODE b,n;
                    627:        DP *ps;
                    628:        DP g;
                    629:        DP nm;
                    630:        P dn;
                    631:        int full;
                    632:
1.11      noro      633:        do_weyl = 0;
1.1       noro      634:        asir_assert(ARG0(arg),O_LIST,"dp_true_nf");
                    635:        asir_assert(ARG1(arg),O_DP,"dp_true_nf");
                    636:        asir_assert(ARG2(arg),O_VECT,"dp_true_nf");
                    637:        asir_assert(ARG3(arg),O_N,"dp_nf");
                    638:        if ( !(g = (DP)ARG1(arg)) ) {
                    639:                nm = 0; dn = (P)ONE;
                    640:        } else {
                    641:                b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
                    642:                full = (Q)ARG3(arg) ? 1 : 0;
                    643:                dp_true_nf(b,g,ps,full,&nm,&dn);
                    644:        }
                    645:        NEWNODE(n); BDY(n) = (pointer)nm;
                    646:        NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn;
                    647:        NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
                    648: }
                    649:
1.13      noro      650: void Pdp_weyl_nf_mod(arg,rp)
1.8       noro      651: NODE arg;
                    652: DP *rp;
                    653: {
                    654:        NODE b;
                    655:        DP g;
                    656:        DP *ps;
                    657:        int mod,full,ac;
1.9       noro      658:        NODE n,n0;
1.8       noro      659:
                    660:        ac = argc(arg);
1.14      noro      661:        asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_mod");
                    662:        asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_mod");
                    663:        asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_mod");
                    664:        asir_assert(ARG3(arg),O_N,"dp_weyl_nf_mod");
                    665:        asir_assert(ARG4(arg),O_N,"dp_weyl_nf_mod");
1.8       noro      666:        if ( !(g = (DP)ARG1(arg)) ) {
                    667:                *rp = 0; return;
                    668:        }
                    669:        b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
                    670:        full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));
1.9       noro      671:        for ( n0 = n = 0; b; b = NEXT(b) ) {
                    672:                NEXTNODE(n0,n);
                    673:                BDY(n) = (pointer)QTOS((Q)BDY(b));
                    674:        }
                    675:        if ( n0 )
                    676:                NEXT(n) = 0;
1.13      noro      677:        do_weyl = 1;
                    678:        dp_nf_mod(n0,g,ps,mod,full,rp);
                    679:        do_weyl = 0;
1.8       noro      680: }
                    681:
                    682: void Pdp_true_nf_mod(arg,rp)
                    683: NODE arg;
                    684: LIST *rp;
                    685: {
                    686:        NODE b;
                    687:        DP g,nm;
                    688:        P dn;
                    689:        DP *ps;
                    690:        int mod,full;
                    691:        NODE n;
                    692:
1.11      noro      693:        do_weyl = 0;
1.8       noro      694:        asir_assert(ARG0(arg),O_LIST,"dp_nf_mod");
                    695:        asir_assert(ARG1(arg),O_DP,"dp_nf_mod");
                    696:        asir_assert(ARG2(arg),O_VECT,"dp_nf_mod");
                    697:        asir_assert(ARG3(arg),O_N,"dp_nf_mod");
                    698:        asir_assert(ARG4(arg),O_N,"dp_nf_mod");
                    699:        if ( !(g = (DP)ARG1(arg)) ) {
                    700:                nm = 0; dn = (P)ONEM;
                    701:        } else {
                    702:                b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
                    703:                full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));
                    704:                dp_true_nf_mod(b,g,ps,mod,full,&nm,&dn);
                    705:        }
                    706:        NEWNODE(n); BDY(n) = (pointer)nm;
                    707:        NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn;
                    708:        NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
1.1       noro      709: }
                    710:
                    711: void Pdp_tdiv(arg,rp)
                    712: NODE arg;
                    713: DP *rp;
                    714: {
                    715:        MP m,mr,mr0;
                    716:        DP p;
                    717:        Q c;
                    718:        N d,q,r;
                    719:        int sgn;
                    720:
                    721:        asir_assert(ARG0(arg),O_DP,"dp_tdiv");
                    722:        asir_assert(ARG1(arg),O_N,"dp_tdiv");
                    723:        p = (DP)ARG0(arg); d = NM((Q)ARG1(arg)); sgn = SGN((Q)ARG1(arg));
                    724:        if ( !p )
                    725:                *rp = 0;
                    726:        else {
                    727:                for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
                    728:                        divn(NM((Q)m->c),d,&q,&r);
                    729:                        if ( r ) {
                    730:                                *rp = 0; return;
                    731:                        } else {
                    732:                                NEXTMP(mr0,mr); NTOQ(q,SGN((Q)m->c)*sgn,c);
                    733:                                mr->c = (P)c; mr->dl = m->dl;
                    734:                        }
                    735:                }
                    736:                NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
                    737:        }
                    738: }
                    739:
                    740: void Pdp_red_coef(arg,rp)
                    741: NODE arg;
                    742: DP *rp;
                    743: {
                    744:        MP m,mr,mr0;
                    745:        P q,r;
                    746:        DP p;
                    747:        P mod;
                    748:
                    749:        p = (DP)ARG0(arg); mod = (P)ARG1(arg);
                    750:        asir_assert(p,O_DP,"dp_red_coef");
                    751:        asir_assert(mod,O_P,"dp_red_coef");
                    752:        if ( !p )
                    753:                *rp = 0;
                    754:        else {
                    755:                for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
                    756:                        divsrp(CO,m->c,mod,&q,&r);
                    757:                        if ( r ) {
                    758:                                NEXTMP(mr0,mr); mr->c = r; mr->dl = m->dl;
                    759:                        }
                    760:                }
                    761:                if ( mr0 ) {
                    762:                        NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
                    763:                } else
                    764:                        *rp = 0;
                    765:        }
                    766: }
                    767:
                    768: void Pdp_redble(arg,rp)
                    769: NODE arg;
                    770: Q *rp;
                    771: {
                    772:        asir_assert(ARG0(arg),O_DP,"dp_redble");
                    773:        asir_assert(ARG1(arg),O_DP,"dp_redble");
                    774:        if ( dp_redble((DP)ARG0(arg),(DP)ARG1(arg)) )
                    775:                *rp = ONE;
                    776:        else
                    777:                *rp = 0;
                    778: }
                    779:
                    780: void Pdp_red_mod(arg,rp)
                    781: NODE arg;
                    782: LIST *rp;
                    783: {
                    784:        DP h,r;
                    785:        P dmy;
                    786:        NODE n;
                    787:
1.11      noro      788:        do_weyl = 0;
1.1       noro      789:        asir_assert(ARG0(arg),O_DP,"dp_red_mod");
                    790:        asir_assert(ARG1(arg),O_DP,"dp_red_mod");
                    791:        asir_assert(ARG2(arg),O_DP,"dp_red_mod");
                    792:        asir_assert(ARG3(arg),O_N,"dp_red_mod");
                    793:        dp_red_mod((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),QTOS((Q)ARG3(arg)),
                    794:                &h,&r,&dmy);
                    795:        NEWNODE(n); BDY(n) = (pointer)h;
                    796:        NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r;
                    797:        NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
                    798: }
1.13      noro      799:
1.1       noro      800: void Pdp_subd(arg,rp)
                    801: NODE arg;
                    802: DP *rp;
                    803: {
                    804:        DP p1,p2;
                    805:
                    806:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
                    807:        asir_assert(p1,O_DP,"dp_subd");
                    808:        asir_assert(p2,O_DP,"dp_subd");
                    809:        dp_subd(p1,p2,rp);
                    810: }
                    811:
1.12      noro      812: void Pdp_weyl_mul(arg,rp)
                    813: NODE arg;
                    814: DP *rp;
                    815: {
                    816:        DP p1,p2;
                    817:
                    818:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
                    819:        asir_assert(p1,O_DP,"dp_weyl_mul"); asir_assert(p2,O_DP,"dp_mul");
                    820:        do_weyl = 1;
                    821:        muld(CO,p1,p2,rp);
1.13      noro      822:        do_weyl = 0;
                    823: }
                    824:
                    825: void Pdp_weyl_mul_mod(arg,rp)
                    826: NODE arg;
                    827: DP *rp;
                    828: {
                    829:        DP p1,p2;
                    830:        Q m;
                    831:
                    832:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); m = (Q)ARG2(arg);
                    833:        asir_assert(p1,O_DP,"dp_weyl_mul_mod");
                    834:        asir_assert(p2,O_DP,"dp_mul_mod");
                    835:        asir_assert(m,O_N,"dp_mul_mod");
                    836:        do_weyl = 1;
                    837:        mulmd(CO,QTOS(m),p1,p2,rp);
1.12      noro      838:        do_weyl = 0;
                    839: }
                    840:
1.1       noro      841: void Pdp_red(arg,rp)
                    842: NODE arg;
                    843: LIST *rp;
                    844: {
                    845:        NODE n;
1.4       noro      846:        DP head,rest,dmy1;
1.1       noro      847:        P dmy;
                    848:
1.11      noro      849:        do_weyl = 0;
1.1       noro      850:        asir_assert(ARG0(arg),O_DP,"dp_red");
                    851:        asir_assert(ARG1(arg),O_DP,"dp_red");
                    852:        asir_assert(ARG2(arg),O_DP,"dp_red");
1.4       noro      853:        dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1);
1.1       noro      854:        NEWNODE(n); BDY(n) = (pointer)head;
                    855:        NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest;
                    856:        NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
                    857: }
                    858:
1.11      noro      859: void Pdp_weyl_red(arg,rp)
                    860: NODE arg;
                    861: LIST *rp;
                    862: {
                    863:        NODE n;
                    864:        DP head,rest,dmy1;
                    865:        P dmy;
                    866:
                    867:        asir_assert(ARG0(arg),O_DP,"dp_weyl_red");
                    868:        asir_assert(ARG1(arg),O_DP,"dp_weyl_red");
                    869:        asir_assert(ARG2(arg),O_DP,"dp_weyl_red");
1.12      noro      870:        do_weyl = 1;
1.11      noro      871:        dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1);
1.12      noro      872:        do_weyl = 0;
1.11      noro      873:        NEWNODE(n); BDY(n) = (pointer)head;
                    874:        NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest;
                    875:        NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
                    876: }
                    877:
1.1       noro      878: void Pdp_sp(arg,rp)
                    879: NODE arg;
                    880: DP *rp;
                    881: {
                    882:        DP p1,p2;
                    883:
1.11      noro      884:        do_weyl = 0;
1.1       noro      885:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
                    886:        asir_assert(p1,O_DP,"dp_sp"); asir_assert(p2,O_DP,"dp_sp");
                    887:        dp_sp(p1,p2,rp);
                    888: }
                    889:
1.11      noro      890: void Pdp_weyl_sp(arg,rp)
                    891: NODE arg;
                    892: DP *rp;
                    893: {
                    894:        DP p1,p2;
                    895:
                    896:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
                    897:        asir_assert(p1,O_DP,"dp_weyl_sp"); asir_assert(p2,O_DP,"dp_sp");
1.12      noro      898:        do_weyl = 1;
1.11      noro      899:        dp_sp(p1,p2,rp);
1.12      noro      900:        do_weyl = 0;
1.11      noro      901: }
                    902:
1.1       noro      903: void Pdp_sp_mod(arg,rp)
                    904: NODE arg;
                    905: DP *rp;
                    906: {
                    907:        DP p1,p2;
                    908:        int mod;
                    909:
1.11      noro      910:        do_weyl = 0;
1.1       noro      911:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
                    912:        asir_assert(p1,O_DP,"dp_sp_mod"); asir_assert(p2,O_DP,"dp_sp_mod");
                    913:        asir_assert(ARG2(arg),O_N,"dp_sp_mod");
                    914:        mod = QTOS((Q)ARG2(arg));
                    915:        dp_sp_mod(p1,p2,mod,rp);
                    916: }
                    917:
                    918: void Pdp_lcm(arg,rp)
                    919: NODE arg;
                    920: DP *rp;
                    921: {
                    922:        int i,n,td;
                    923:        DL d1,d2,d;
                    924:        MP m;
                    925:        DP p1,p2;
                    926:
                    927:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
                    928:        asir_assert(p1,O_DP,"dp_lcm"); asir_assert(p2,O_DP,"dp_lcm");
                    929:        n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl;
                    930:        NEWDL(d,n);
                    931:        for ( i = 0, td = 0; i < n; i++ ) {
                    932:                d->d[i] = MAX(d1->d[i],d2->d[i]); td += d->d[i];
                    933:        }
                    934:        d->td = td;
                    935:        NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0;
                    936:        MKDP(n,m,*rp); (*rp)->sugar = td;       /* XXX */
                    937: }
                    938:
                    939: void Pdp_hm(arg,rp)
                    940: NODE arg;
                    941: DP *rp;
                    942: {
                    943:        DP p;
                    944:
                    945:        p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_hm");
                    946:        dp_hm(p,rp);
                    947: }
                    948:
                    949: void Pdp_ht(arg,rp)
                    950: NODE arg;
                    951: DP *rp;
                    952: {
                    953:        DP p;
                    954:        MP m,mr;
                    955:
                    956:        p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_ht");
                    957:        if ( !p )
                    958:                *rp = 0;
                    959:        else {
                    960:                m = BDY(p);
                    961:                NEWMP(mr); mr->dl = m->dl; mr->c = (P)ONE; NEXT(mr) = 0;
                    962:                MKDP(p->nv,mr,*rp); (*rp)->sugar = mr->dl->td;  /* XXX */
                    963:        }
                    964: }
                    965:
                    966: void Pdp_hc(arg,rp)
                    967: NODE arg;
                    968: P *rp;
                    969: {
                    970:        asir_assert(ARG0(arg),O_DP,"dp_hc");
                    971:        if ( !ARG0(arg) )
                    972:                *rp = 0;
                    973:        else
                    974:                *rp = BDY((DP)ARG0(arg))->c;
                    975: }
                    976:
                    977: void Pdp_rest(arg,rp)
                    978: NODE arg;
                    979: DP *rp;
                    980: {
                    981:        asir_assert(ARG0(arg),O_DP,"dp_rest");
                    982:        if ( !ARG0(arg) )
                    983:                *rp = 0;
                    984:        else
                    985:                dp_rest((DP)ARG0(arg),rp);
                    986: }
                    987:
                    988: void Pdp_td(arg,rp)
                    989: NODE arg;
                    990: Q *rp;
                    991: {
                    992:        DP p;
                    993:
                    994:        p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_td");
                    995:        if ( !p )
                    996:                *rp = 0;
                    997:        else
                    998:                STOQ(BDY(p)->dl->td,*rp);
                    999: }
                   1000:
                   1001: void Pdp_sugar(arg,rp)
                   1002: NODE arg;
                   1003: Q *rp;
                   1004: {
                   1005:        DP p;
                   1006:
                   1007:        p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_sugar");
                   1008:        if ( !p )
                   1009:                *rp = 0;
                   1010:        else
                   1011:                STOQ(p->sugar,*rp);
                   1012: }
                   1013:
                   1014: void Pdp_cri1(arg,rp)
                   1015: NODE arg;
                   1016: Q *rp;
                   1017: {
                   1018:        DP p1,p2;
                   1019:        int *d1,*d2;
                   1020:        int i,n;
                   1021:
                   1022:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
                   1023:        asir_assert(p1,O_DP,"dp_cri1"); asir_assert(p2,O_DP,"dp_cri1");
                   1024:        n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d;
                   1025:        for ( i = 0; i < n; i++ )
                   1026:                if ( d1[i] > d2[i] )
                   1027:                        break;
                   1028:        *rp = i == n ? ONE : 0;
                   1029: }
                   1030:
                   1031: void Pdp_cri2(arg,rp)
                   1032: NODE arg;
                   1033: Q *rp;
                   1034: {
                   1035:        DP p1,p2;
                   1036:        int *d1,*d2;
                   1037:        int i,n;
                   1038:
                   1039:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
                   1040:        asir_assert(p1,O_DP,"dp_cri2"); asir_assert(p2,O_DP,"dp_cri2");
                   1041:        n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d;
                   1042:        for ( i = 0; i < n; i++ )
                   1043:                if ( MIN(d1[i],d2[i]) >= 1 )
                   1044:                        break;
                   1045:        *rp = i == n ? ONE : 0;
                   1046: }
                   1047:
                   1048: void Pdp_minp(arg,rp)
                   1049: NODE arg;
                   1050: LIST *rp;
                   1051: {
                   1052:        NODE tn,tn1,d,dd,dd0,p,tp;
                   1053:        LIST l,minp;
                   1054:        DP lcm,tlcm;
                   1055:        int s,ts;
                   1056:
                   1057:        asir_assert(ARG0(arg),O_LIST,"dp_minp");
                   1058:        d = BDY((LIST)ARG0(arg)); minp = (LIST)BDY(d);
                   1059:        p = BDY(minp); p = NEXT(NEXT(p)); lcm = (DP)BDY(p); p = NEXT(p);
                   1060:        if ( !ARG1(arg) ) {
                   1061:                s = QTOS((Q)BDY(p)); p = NEXT(p);
                   1062:                for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) {
                   1063:                        tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp));
                   1064:                        tlcm = (DP)BDY(tp); tp = NEXT(tp);
                   1065:                        ts = QTOS((Q)BDY(tp)); tp = NEXT(tp);
                   1066:                        NEXTNODE(dd0,dd);
                   1067:                        if ( ts < s ) {
                   1068:                                BDY(dd) = (pointer)minp;
                   1069:                                minp = (LIST)BDY(d); lcm = tlcm; s = ts;
                   1070:                        } else if ( ts == s ) {
                   1071:                                if ( compd(CO,lcm,tlcm) > 0 ) {
                   1072:                                        BDY(dd) = (pointer)minp;
                   1073:                                        minp = (LIST)BDY(d); lcm = tlcm; s = ts;
                   1074:                                } else
                   1075:                                        BDY(dd) = BDY(d);
                   1076:                        } else
                   1077:                                BDY(dd) = BDY(d);
                   1078:                }
                   1079:        } else {
                   1080:                for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) {
                   1081:                        tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp));
                   1082:                        tlcm = (DP)BDY(tp);
                   1083:                        NEXTNODE(dd0,dd);
                   1084:                        if ( compd(CO,lcm,tlcm) > 0 ) {
                   1085:                                BDY(dd) = (pointer)minp; minp = (LIST)BDY(d); lcm = tlcm;
                   1086:                        } else
                   1087:                                BDY(dd) = BDY(d);
                   1088:                }
                   1089:        }
                   1090:        if ( dd0 )
                   1091:                NEXT(dd) = 0;
                   1092:        MKLIST(l,dd0); MKNODE(tn,l,0); MKNODE(tn1,minp,tn); MKLIST(*rp,tn1);
                   1093: }
                   1094:
                   1095: void Pdp_criB(arg,rp)
                   1096: NODE arg;
                   1097: LIST *rp;
                   1098: {
                   1099:        NODE d,ij,dd,ddd;
                   1100:        int i,j,s,n;
                   1101:        DP *ps;
                   1102:        DL ts,ti,tj,lij,tdl;
                   1103:
                   1104:        asir_assert(ARG0(arg),O_LIST,"dp_criB"); d = BDY((LIST)ARG0(arg));
                   1105:        asir_assert(ARG1(arg),O_N,"dp_criB"); s = QTOS((Q)ARG1(arg));
                   1106:        asir_assert(ARG2(arg),O_VECT,"dp_criB"); ps = (DP *)BDY((VECT)ARG2(arg));
                   1107:        if ( !d )
                   1108:                *rp = (LIST)ARG0(arg);
                   1109:        else {
                   1110:                ts = BDY(ps[s])->dl;
                   1111:                n = ps[s]->nv;
                   1112:                NEWDL(tdl,n);
                   1113:                for ( dd = 0; d; d = NEXT(d) ) {
                   1114:                        ij = BDY((LIST)BDY(d));
                   1115:                        i = QTOS((Q)BDY(ij)); ij = NEXT(ij);
                   1116:                        j = QTOS((Q)BDY(ij)); ij = NEXT(ij);
                   1117:                        lij = BDY((DP)BDY(ij))->dl;
                   1118:                        ti = BDY(ps[i])->dl; tj = BDY(ps[j])->dl;
                   1119:                        if ( lij->td != lcm_of_DL(n,lij,ts,tdl)->td
                   1120:                                || !dl_equal(n,lij,tdl)
                   1121:                                || (lij->td == lcm_of_DL(n,ti,ts,tdl)->td
                   1122:                                        && dl_equal(n,tdl,lij))
                   1123:                                || (lij->td == lcm_of_DL(n,tj,ts,tdl)->td
                   1124:                                        && dl_equal(n,tdl,lij)) ) {
                   1125:                                MKNODE(ddd,BDY(d),dd);
                   1126:                                dd = ddd;
                   1127:                        }
                   1128:                }
                   1129:                MKLIST(*rp,dd);
                   1130:        }
                   1131: }
                   1132:
                   1133: void Pdp_nelim(arg,rp)
                   1134: NODE arg;
                   1135: Q *rp;
                   1136: {
                   1137:        if ( arg ) {
                   1138:                asir_assert(ARG0(arg),O_N,"dp_nelim");
                   1139:                dp_nelim = QTOS((Q)ARG0(arg));
                   1140:        }
                   1141:        STOQ(dp_nelim,*rp);
                   1142: }
                   1143:
                   1144: void Pdp_mag(arg,rp)
                   1145: NODE arg;
                   1146: Q *rp;
                   1147: {
                   1148:        DP p;
                   1149:        int s;
                   1150:        MP m;
                   1151:
                   1152:        p = (DP)ARG0(arg);
                   1153:        asir_assert(p,O_DP,"dp_mag");
                   1154:        if ( !p )
                   1155:                *rp = 0;
                   1156:        else {
                   1157:                for ( s = 0, m = BDY(p); m; m = NEXT(m) )
                   1158:                        s += p_mag(m->c);
                   1159:                STOQ(s,*rp);
                   1160:        }
                   1161: }
                   1162:
                   1163: extern int kara_mag;
                   1164:
                   1165: void Pdp_set_kara(arg,rp)
                   1166: NODE arg;
                   1167: Q *rp;
                   1168: {
                   1169:        if ( arg ) {
                   1170:                asir_assert(ARG0(arg),O_N,"dp_set_kara");
                   1171:                kara_mag = QTOS((Q)ARG0(arg));
                   1172:        }
                   1173:        STOQ(kara_mag,*rp);
                   1174: }
                   1175:
                   1176: void Pdp_homo(arg,rp)
                   1177: NODE arg;
                   1178: DP *rp;
                   1179: {
                   1180:        asir_assert(ARG0(arg),O_DP,"dp_homo");
                   1181:        dp_homo((DP)ARG0(arg),rp);
                   1182: }
                   1183:
1.8       noro     1184: void Pdp_dehomo(arg,rp)
                   1185: NODE arg;
1.1       noro     1186: DP *rp;
                   1187: {
1.8       noro     1188:        asir_assert(ARG0(arg),O_DP,"dp_dehomo");
                   1189:        dp_dehomo((DP)ARG0(arg),rp);
                   1190: }
                   1191:
                   1192: void Pdp_gr_flags(arg,rp)
                   1193: NODE arg;
                   1194: LIST *rp;
                   1195: {
                   1196:        Obj name,value;
                   1197:        NODE n;
1.1       noro     1198:
1.8       noro     1199:        if ( arg ) {
                   1200:                asir_assert(ARG0(arg),O_LIST,"dp_gr_flags");
                   1201:                n = BDY((LIST)ARG0(arg));
                   1202:                while ( n ) {
                   1203:                        name = (Obj)BDY(n); n = NEXT(n);
                   1204:                        if ( !n )
                   1205:                                break;
                   1206:                        else {
                   1207:                                value = (Obj)BDY(n); n = NEXT(n);
                   1208:                        }
                   1209:                        dp_set_flag(name,value);
1.1       noro     1210:                }
                   1211:        }
1.8       noro     1212:        dp_make_flaglist(rp);
                   1213: }
                   1214:
                   1215: extern int DP_Print;
                   1216:
                   1217: void Pdp_gr_print(arg,rp)
                   1218: NODE arg;
                   1219: Q *rp;
                   1220: {
                   1221:        Q q;
                   1222:
                   1223:        if ( arg ) {
                   1224:                asir_assert(ARG0(arg),O_N,"dp_gr_print");
                   1225:                q = (Q)ARG0(arg); DP_Print = QTOS(q);
                   1226:        } else
                   1227:                STOQ(DP_Print,q);
                   1228:        *rp = q;
1.1       noro     1229: }
                   1230:
1.8       noro     1231: void Pdp_gr_main(arg,rp)
1.1       noro     1232: NODE arg;
1.8       noro     1233: LIST *rp;
1.1       noro     1234: {
1.8       noro     1235:        LIST f,v;
                   1236:        Num homo;
                   1237:        Q m;
                   1238:        int modular;
                   1239:        struct order_spec ord;
                   1240:
1.11      noro     1241:        do_weyl = 0;
1.8       noro     1242:        asir_assert(ARG0(arg),O_LIST,"dp_gr_main");
                   1243:        asir_assert(ARG1(arg),O_LIST,"dp_gr_main");
                   1244:        asir_assert(ARG2(arg),O_N,"dp_gr_main");
                   1245:        asir_assert(ARG3(arg),O_N,"dp_gr_main");
                   1246:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                   1247:        homo = (Num)ARG2(arg);
                   1248:        m = (Q)ARG3(arg);
                   1249:        if ( !m )
                   1250:                modular = 0;
                   1251:        else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) )
                   1252:                error("dp_gr_main : too large modulus");
                   1253:        else
                   1254:                modular = QTOS(m);
                   1255:        create_order_spec(ARG4(arg),&ord);
1.16    ! noro     1256:        dp_gr_main(f,v,homo,modular,0,&ord,rp);
        !          1257: }
        !          1258:
        !          1259: void Pdp_gr_f_main(arg,rp)
        !          1260: NODE arg;
        !          1261: LIST *rp;
        !          1262: {
        !          1263:        LIST f,v;
        !          1264:        Num homo;
        !          1265:        struct order_spec ord;
        !          1266:
        !          1267:        do_weyl = 0;
        !          1268:        asir_assert(ARG0(arg),O_LIST,"dp_gr_f_main");
        !          1269:        asir_assert(ARG1(arg),O_LIST,"dp_gr_f_main");
        !          1270:        asir_assert(ARG2(arg),O_N,"dp_gr_f_main");
        !          1271:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
        !          1272:        homo = (Num)ARG2(arg);
        !          1273:        create_order_spec(ARG3(arg),&ord);
        !          1274:        dp_gr_main(f,v,homo,0,1,&ord,rp);
1.1       noro     1275: }
                   1276:
1.8       noro     1277: void Pdp_f4_main(arg,rp)
                   1278: NODE arg;
                   1279: LIST *rp;
1.1       noro     1280: {
1.8       noro     1281:        LIST f,v;
                   1282:        struct order_spec ord;
1.1       noro     1283:
1.11      noro     1284:        do_weyl = 0;
1.8       noro     1285:        asir_assert(ARG0(arg),O_LIST,"dp_f4_main");
                   1286:        asir_assert(ARG1(arg),O_LIST,"dp_f4_main");
                   1287:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                   1288:        create_order_spec(ARG2(arg),&ord);
1.16    ! noro     1289:        dp_f4_main(f,v,0,&ord,rp);
        !          1290: }
        !          1291:
        !          1292: void Pdp_f4_f_main(arg,rp)
        !          1293: NODE arg;
        !          1294: LIST *rp;
        !          1295: {
        !          1296:        LIST f,v;
        !          1297:        struct order_spec ord;
        !          1298:
        !          1299:        do_weyl = 0;
        !          1300:        asir_assert(ARG0(arg),O_LIST,"dp_f4_f_main");
        !          1301:        asir_assert(ARG1(arg),O_LIST,"dp_f4_f_main");
        !          1302:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
        !          1303:        create_order_spec(ARG2(arg),&ord);
        !          1304:        dp_f4_main(f,v,1,&ord,rp);
1.1       noro     1305: }
                   1306:
1.8       noro     1307: void Pdp_f4_mod_main(arg,rp)
                   1308: NODE arg;
                   1309: LIST *rp;
1.1       noro     1310: {
1.8       noro     1311:        LIST f,v;
                   1312:        int m;
                   1313:        struct order_spec ord;
                   1314:
1.11      noro     1315:        do_weyl = 0;
1.8       noro     1316:        asir_assert(ARG0(arg),O_LIST,"dp_f4_main");
                   1317:        asir_assert(ARG1(arg),O_LIST,"dp_f4_main");
                   1318:        asir_assert(ARG2(arg),O_N,"dp_f4_main");
                   1319:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg));
                   1320:        create_order_spec(ARG3(arg),&ord);
                   1321:        dp_f4_mod_main(f,v,m,&ord,rp);
                   1322: }
1.1       noro     1323:
1.8       noro     1324: void Pdp_gr_mod_main(arg,rp)
                   1325: NODE arg;
                   1326: LIST *rp;
                   1327: {
                   1328:        LIST f,v;
                   1329:        Num homo;
                   1330:        int m;
                   1331:        struct order_spec ord;
                   1332:
1.11      noro     1333:        do_weyl = 0;
1.8       noro     1334:        asir_assert(ARG0(arg),O_LIST,"dp_gr_mod_main");
                   1335:        asir_assert(ARG1(arg),O_LIST,"dp_gr_mod_main");
                   1336:        asir_assert(ARG2(arg),O_N,"dp_gr_mod_main");
                   1337:        asir_assert(ARG3(arg),O_N,"dp_gr_mod_main");
1.11      noro     1338:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                   1339:        homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg));
                   1340:        create_order_spec(ARG4(arg),&ord);
                   1341:        dp_gr_mod_main(f,v,homo,m,&ord,rp);
                   1342: }
                   1343:
                   1344: /* for Weyl algebra */
                   1345:
                   1346: void Pdp_weyl_gr_main(arg,rp)
                   1347: NODE arg;
                   1348: LIST *rp;
                   1349: {
                   1350:        LIST f,v;
                   1351:        Num homo;
                   1352:        Q m;
                   1353:        int modular;
                   1354:        struct order_spec ord;
                   1355:
                   1356:        asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main");
                   1357:        asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main");
                   1358:        asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main");
                   1359:        asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main");
                   1360:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                   1361:        homo = (Num)ARG2(arg);
                   1362:        m = (Q)ARG3(arg);
                   1363:        if ( !m )
                   1364:                modular = 0;
                   1365:        else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) )
                   1366:                error("dp_gr_main : too large modulus");
                   1367:        else
                   1368:                modular = QTOS(m);
                   1369:        create_order_spec(ARG4(arg),&ord);
1.12      noro     1370:        do_weyl = 1;
1.16    ! noro     1371:        dp_gr_main(f,v,homo,modular,0,&ord,rp);
        !          1372:        do_weyl = 0;
        !          1373: }
        !          1374:
        !          1375: void Pdp_weyl_gr_f_main(arg,rp)
        !          1376: NODE arg;
        !          1377: LIST *rp;
        !          1378: {
        !          1379:        LIST f,v;
        !          1380:        Num homo;
        !          1381:        Q m;
        !          1382:        int modular;
        !          1383:        struct order_spec ord;
        !          1384:
        !          1385:        asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main");
        !          1386:        asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main");
        !          1387:        asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main");
        !          1388:        asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main");
        !          1389:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
        !          1390:        homo = (Num)ARG2(arg);
        !          1391:        create_order_spec(ARG3(arg),&ord);
        !          1392:        do_weyl = 1;
        !          1393:        dp_gr_main(f,v,homo,0,1,&ord,rp);
1.12      noro     1394:        do_weyl = 0;
1.11      noro     1395: }
                   1396:
                   1397: void Pdp_weyl_f4_main(arg,rp)
                   1398: NODE arg;
                   1399: LIST *rp;
                   1400: {
                   1401:        LIST f,v;
                   1402:        struct order_spec ord;
                   1403:
                   1404:        asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main");
                   1405:        asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main");
                   1406:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                   1407:        create_order_spec(ARG2(arg),&ord);
1.12      noro     1408:        do_weyl = 1;
1.16    ! noro     1409:        dp_f4_main(f,v,0,&ord,rp);
        !          1410:        do_weyl = 0;
        !          1411: }
        !          1412:
        !          1413: void Pdp_weyl_f4_f_main(arg,rp)
        !          1414: NODE arg;
        !          1415: LIST *rp;
        !          1416: {
        !          1417:        LIST f,v;
        !          1418:        struct order_spec ord;
        !          1419:
        !          1420:        asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main");
        !          1421:        asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main");
        !          1422:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
        !          1423:        create_order_spec(ARG2(arg),&ord);
        !          1424:        do_weyl = 1;
        !          1425:        dp_f4_main(f,v,1,&ord,rp);
1.12      noro     1426:        do_weyl = 0;
1.11      noro     1427: }
                   1428:
                   1429: void Pdp_weyl_f4_mod_main(arg,rp)
                   1430: NODE arg;
                   1431: LIST *rp;
                   1432: {
                   1433:        LIST f,v;
                   1434:        int m;
                   1435:        struct order_spec ord;
                   1436:
                   1437:        asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main");
                   1438:        asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main");
                   1439:        asir_assert(ARG2(arg),O_N,"dp_f4_main");
                   1440:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg));
                   1441:        create_order_spec(ARG3(arg),&ord);
1.12      noro     1442:        do_weyl = 1;
1.11      noro     1443:        dp_f4_mod_main(f,v,m,&ord,rp);
1.12      noro     1444:        do_weyl = 0;
1.11      noro     1445: }
                   1446:
                   1447: void Pdp_weyl_gr_mod_main(arg,rp)
                   1448: NODE arg;
                   1449: LIST *rp;
                   1450: {
                   1451:        LIST f,v;
                   1452:        Num homo;
                   1453:        int m;
                   1454:        struct order_spec ord;
                   1455:
                   1456:        asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_mod_main");
                   1457:        asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_mod_main");
                   1458:        asir_assert(ARG2(arg),O_N,"dp_weyl_gr_mod_main");
                   1459:        asir_assert(ARG3(arg),O_N,"dp_weyl_gr_mod_main");
1.8       noro     1460:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                   1461:        homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg));
                   1462:        create_order_spec(ARG4(arg),&ord);
1.12      noro     1463:        do_weyl = 1;
1.8       noro     1464:        dp_gr_mod_main(f,v,homo,m,&ord,rp);
1.12      noro     1465:        do_weyl = 0;
1.1       noro     1466: }
1.8       noro     1467:
1.15      noro     1468: static VECT current_weight_vector_obj;
                   1469: int *current_weight_vector;
                   1470:
                   1471: void Pdp_weyl_set_weight(arg,rp)
                   1472: NODE arg;
                   1473: VECT *rp;
                   1474: {
                   1475:        VECT v;
                   1476:        int i,n;
                   1477:
                   1478:        if ( !arg )
                   1479:                *rp = current_weight_vector_obj;
                   1480:        else {
                   1481:                asir_assert(ARG0(arg),O_VECT,"dp_weyl_set_weight");
                   1482:                v = (VECT)ARG0(arg);
                   1483:                current_weight_vector_obj = v;
                   1484:                n = v->len;
                   1485:                current_weight_vector = (int *)CALLOC(n,sizeof(int));
                   1486:                for ( i = 0; i < n; i++ )
                   1487:                        current_weight_vector[i] = QTOS((Q)v->body[i]);
                   1488:                *rp = v;
                   1489:        }
                   1490: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>