[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.92

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
1.68      noro        9:  * conditions of this Agreement. For the avoidance of doubt, you acquire * only a limited right to use the SOFTWARE hereunder, and FLL or any
1.5       noro       10:  * third party developer retains all rights, including but not limited to
                     11:  * copyrights, in and to the SOFTWARE.
                     12:  *
                     13:  * (1) FLL does not grant you a license in any way for commercial
                     14:  * purposes. You may use the SOFTWARE only for non-commercial and
                     15:  * non-profit purposes only, such as academic, research and internal
                     16:  * business use.
                     17:  * (2) The SOFTWARE is protected by the Copyright Law of Japan and
                     18:  * international copyright treaties. If you make copies of the SOFTWARE,
                     19:  * with or without modification, as permitted hereunder, you shall affix
                     20:  * to all such copies of the SOFTWARE the above copyright notice.
                     21:  * (3) An explicit reference to this SOFTWARE and its copyright owner
                     22:  * shall be made on your publication or presentation in any form of the
                     23:  * results obtained by use of the SOFTWARE.
                     24:  * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
1.6       noro       25:  * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.5       noro       26:  * for such modification or the source code of the modified part of the
                     27:  * SOFTWARE.
                     28:  *
                     29:  * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
                     30:  * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
                     31:  * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
                     32:  * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
                     33:  * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
                     34:  * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
                     35:  * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
                     36:  * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
                     37:  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
                     38:  * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
                     39:  * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
                     40:  * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
                     41:  * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
                     42:  * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
                     43:  * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
                     44:  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
                     45:  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
                     46:  *
1.92    ! noro       47:  * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.91 2013/09/12 06:46:16 noro Exp $
1.5       noro       48: */
1.1       noro       49: #include "ca.h"
                     50: #include "base.h"
                     51: #include "parse.h"
                     52:
1.61      noro       53: extern int dp_fcoeffs;
1.8       noro       54: extern int dp_nelim;
                     55: extern int dp_order_pair_length;
                     56: extern struct order_pair *dp_order_pair;
1.46      noro       57: extern struct order_spec *dp_current_spec;
1.52      noro       58: extern struct modorder_spec *dp_current_modspec;
1.8       noro       59:
1.11      noro       60: int do_weyl;
1.1       noro       61:
1.44      noro       62: void Pdp_sort();
1.32      noro       63: void Pdp_mul_trunc(),Pdp_quo();
1.64      noro       64: void Pdp_ord(), Pdp_ptod(), Pdp_dtop(), Phomogenize();
1.1       noro       65: void Pdp_ptozp(), Pdp_ptozp2(), Pdp_red(), Pdp_red2(), Pdp_lcm(), Pdp_redble();
                     66: void Pdp_sp(), Pdp_hm(), Pdp_ht(), Pdp_hc(), Pdp_rest(), Pdp_td(), Pdp_sugar();
1.30      ohara      67: void Pdp_set_sugar();
1.1       noro       68: void Pdp_cri1(),Pdp_cri2(),Pdp_subd(),Pdp_mod(),Pdp_red_mod(),Pdp_tdiv();
                     69: void Pdp_prim(),Pdp_red_coef(),Pdp_mag(),Pdp_set_kara(),Pdp_rat();
1.70      noro       70: void Pdp_nf(),Pdp_true_nf(),Pdp_true_nf_marked(),Pdp_true_nf_marked_mod();
1.79      noro       71: void Pdp_true_nf_and_quotient_marked(),Pdp_true_nf_and_quotient_marked_mod();
1.1       noro       72: void Pdp_nf_mod(),Pdp_true_nf_mod();
                     73: void Pdp_criB(),Pdp_nelim();
1.9       noro       74: void Pdp_minp(),Pdp_sp_mod();
1.1       noro       75: void Pdp_homo(),Pdp_dehomo();
1.16      noro       76: void Pdp_gr_mod_main(),Pdp_gr_f_main();
1.1       noro       77: void Pdp_gr_main(),Pdp_gr_hm_main(),Pdp_gr_d_main(),Pdp_gr_flags();
1.63      noro       78: void Pdp_interreduce();
1.16      noro       79: void Pdp_f4_main(),Pdp_f4_mod_main(),Pdp_f4_f_main();
1.1       noro       80: void Pdp_gr_print();
1.28      noro       81: void Pdp_mbase(),Pdp_lnf_mod(),Pdp_nf_tab_mod(),Pdp_mdtod(), Pdp_nf_tab_f();
1.8       noro       82: void Pdp_vtoe(), Pdp_etov(), Pdp_dtov(), Pdp_idiv(), Pdp_sep();
                     83: void Pdp_cont();
1.22      noro       84: void Pdp_gr_checklist();
1.52      noro       85: void Pdp_ltod(),Pdpv_ord(),Pdpv_ht(),Pdpv_hm(),Pdpv_hc();
1.1       noro       86:
1.13      noro       87: void Pdp_weyl_red();
                     88: void Pdp_weyl_sp();
                     89: void Pdp_weyl_nf(),Pdp_weyl_nf_mod();
1.16      noro       90: void Pdp_weyl_gr_main(),Pdp_weyl_gr_mod_main(),Pdp_weyl_gr_f_main();
                     91: void Pdp_weyl_f4_main(),Pdp_weyl_f4_mod_main(),Pdp_weyl_f4_f_main();
1.13      noro       92: void Pdp_weyl_mul(),Pdp_weyl_mul_mod();
1.15      noro       93: void Pdp_weyl_set_weight();
1.77      noro       94: void Pdp_set_weight(),Pdp_set_top_weight(),Pdp_set_module_weight();
1.16      noro       95: void Pdp_nf_f(),Pdp_weyl_nf_f();
                     96: void Pdp_lnf_f();
1.62      noro       97: void Pnd_gr(),Pnd_gr_trace(),Pnd_f4(),Pnd_f4_trace();
1.75      noro       98: void Pnd_gr_postproc(), Pnd_weyl_gr_postproc();
1.89      noro       99: void Pnd_gr_recompute_trace(), Pnd_btog();
1.38      noro      100: void Pnd_weyl_gr(),Pnd_weyl_gr_trace();
1.83      noro      101: void Pnd_nf(),Pnd_weyl_nf();
1.49      noro      102: void Pdp_initial_term();
                    103: void Pdp_order();
1.66      noro      104: void Pdp_inv_or_split();
1.74      noro      105: void Pdp_compute_last_t();
1.68      noro      106: void Pdp_compute_last_w();
1.70      noro      107: void Pdp_compute_essential_df();
1.72      noro      108: void Pdp_get_denomlist();
1.80      noro      109: void Pdp_symb_add();
1.82      noro      110: void Pdp_mono_raddec();
1.84      noro      111: void Pdp_mono_reduce();
1.49      noro      112:
                    113: LIST dp_initial_term();
                    114: LIST dp_order();
                    115: void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo,
                    116:        int *modular,struct order_spec **ord);
1.88      ohara     117: NODE dp_inv_or_split(NODE gb,DP f,struct order_spec *spec, DP *inv);
1.11      noro      118:
1.25      noro      119: LIST remove_zero_from_list(LIST);
                    120:
1.1       noro      121: struct ftab dp_tab[] = {
1.8       noro      122:        /* content reduction */
1.1       noro      123:        {"dp_ptozp",Pdp_ptozp,1},
                    124:        {"dp_ptozp2",Pdp_ptozp2,2},
                    125:        {"dp_prim",Pdp_prim,1},
1.8       noro      126:        {"dp_red_coef",Pdp_red_coef,2},
                    127:        {"dp_cont",Pdp_cont,1},
                    128:
1.11      noro      129: /* polynomial ring */
1.32      noro      130:        /* special operations */
                    131:        {"dp_mul_trunc",Pdp_mul_trunc,3},
                    132:        {"dp_quo",Pdp_quo,2},
                    133:
1.8       noro      134:        /* s-poly */
                    135:        {"dp_sp",Pdp_sp,2},
                    136:        {"dp_sp_mod",Pdp_sp_mod,3},
                    137:
                    138:        /* m-reduction */
1.1       noro      139:        {"dp_red",Pdp_red,3},
                    140:        {"dp_red_mod",Pdp_red_mod,4},
1.8       noro      141:
                    142:        /* normal form */
1.1       noro      143:        {"dp_nf",Pdp_nf,4},
1.16      noro      144:        {"dp_nf_f",Pdp_nf_f,4},
1.1       noro      145:        {"dp_true_nf",Pdp_true_nf,4},
1.67      noro      146:        {"dp_true_nf_marked",Pdp_true_nf_marked,4},
1.73      noro      147:        {"dp_true_nf_and_quotient_marked",Pdp_true_nf_and_quotient_marked,4},
1.79      noro      148:        {"dp_true_nf_and_quotient_marked_mod",Pdp_true_nf_and_quotient_marked_mod,5},
1.70      noro      149:        {"dp_true_nf_marked_mod",Pdp_true_nf_marked_mod,5},
1.1       noro      150:        {"dp_nf_mod",Pdp_nf_mod,5},
                    151:        {"dp_true_nf_mod",Pdp_true_nf_mod,5},
1.8       noro      152:        {"dp_lnf_mod",Pdp_lnf_mod,3},
1.28      noro      153:        {"dp_nf_tab_f",Pdp_nf_tab_f,2},
1.8       noro      154:        {"dp_nf_tab_mod",Pdp_nf_tab_mod,3},
1.16      noro      155:        {"dp_lnf_f",Pdp_lnf_f,2},
1.8       noro      156:
                    157:        /* Buchberger algorithm */
1.46      noro      158:        {"dp_gr_main",Pdp_gr_main,-5},
1.63      noro      159:        {"dp_interreduce",Pdp_interreduce,3},
1.1       noro      160:        {"dp_gr_mod_main",Pdp_gr_mod_main,5},
1.27      noro      161:        {"dp_gr_f_main",Pdp_gr_f_main,4},
1.23      noro      162:        {"dp_gr_checklist",Pdp_gr_checklist,2},
1.40      noro      163:        {"nd_f4",Pnd_f4,4},
1.33      noro      164:        {"nd_gr",Pnd_gr,4},
1.36      noro      165:        {"nd_gr_trace",Pnd_gr_trace,5},
1.62      noro      166:        {"nd_f4_trace",Pnd_f4_trace,5},
1.58      noro      167:        {"nd_gr_postproc",Pnd_gr_postproc,5},
1.86      noro      168:        {"nd_gr_recompute_trace",Pnd_gr_recompute_trace,5},
1.90      noro      169:        {"nd_btog",Pnd_btog,-6},
1.75      noro      170:        {"nd_weyl_gr_postproc",Pnd_weyl_gr_postproc,5},
1.38      noro      171:        {"nd_weyl_gr",Pnd_weyl_gr,4},
                    172:        {"nd_weyl_gr_trace",Pnd_weyl_gr_trace,5},
1.39      noro      173:        {"nd_nf",Pnd_nf,5},
1.83      noro      174:        {"nd_weyl_nf",Pnd_weyl_nf,5},
1.8       noro      175:
                    176:        /* F4 algorithm */
1.1       noro      177:        {"dp_f4_main",Pdp_f4_main,3},
                    178:        {"dp_f4_mod_main",Pdp_f4_mod_main,4},
1.8       noro      179:
1.11      noro      180: /* weyl algebra */
1.12      noro      181:        /* multiplication */
                    182:        {"dp_weyl_mul",Pdp_weyl_mul,2},
1.13      noro      183:        {"dp_weyl_mul_mod",Pdp_weyl_mul_mod,3},
1.12      noro      184:
1.11      noro      185:        /* s-poly */
                    186:        {"dp_weyl_sp",Pdp_weyl_sp,2},
                    187:
                    188:        /* m-reduction */
                    189:        {"dp_weyl_red",Pdp_weyl_red,3},
                    190:
                    191:        /* normal form */
                    192:        {"dp_weyl_nf",Pdp_weyl_nf,4},
1.13      noro      193:        {"dp_weyl_nf_mod",Pdp_weyl_nf_mod,5},
1.16      noro      194:        {"dp_weyl_nf_f",Pdp_weyl_nf_f,4},
1.11      noro      195:
                    196:        /* Buchberger algorithm */
1.50      noro      197:        {"dp_weyl_gr_main",Pdp_weyl_gr_main,-5},
1.11      noro      198:        {"dp_weyl_gr_mod_main",Pdp_weyl_gr_mod_main,5},
1.16      noro      199:        {"dp_weyl_gr_f_main",Pdp_weyl_gr_f_main,4},
1.11      noro      200:
                    201:        /* F4 algorithm */
                    202:        {"dp_weyl_f4_main",Pdp_weyl_f4_main,3},
1.19      noro      203:        {"dp_weyl_f4_mod_main",Pdp_weyl_f4_mod_main,4},
1.11      noro      204:
1.15      noro      205:        /* misc */
1.66      noro      206:        {"dp_inv_or_split",Pdp_inv_or_split,3},
1.24      noro      207:        {"dp_set_weight",Pdp_set_weight,-1},
1.77      noro      208:        {"dp_set_module_weight",Pdp_set_module_weight,-1},
1.71      noro      209:        {"dp_set_top_weight",Pdp_set_top_weight,-1},
1.15      noro      210:        {"dp_weyl_set_weight",Pdp_weyl_set_weight,-1},
1.72      noro      211:
                    212:        {"dp_get_denomlist",Pdp_get_denomlist,0},
1.8       noro      213:        {0,0,0},
                    214: };
                    215:
                    216: struct ftab dp_supp_tab[] = {
                    217:        /* setting flags */
1.44      noro      218:        {"dp_sort",Pdp_sort,1},
1.8       noro      219:        {"dp_ord",Pdp_ord,-1},
1.52      noro      220:        {"dpv_ord",Pdpv_ord,-2},
1.8       noro      221:        {"dp_set_kara",Pdp_set_kara,-1},
                    222:        {"dp_nelim",Pdp_nelim,-1},
1.1       noro      223:        {"dp_gr_flags",Pdp_gr_flags,-1},
                    224:        {"dp_gr_print",Pdp_gr_print,-1},
1.8       noro      225:
                    226:        /* converters */
1.64      noro      227:        {"homogenize",Phomogenize,3},
1.53      noro      228:        {"dp_ptod",Pdp_ptod,-2},
1.8       noro      229:        {"dp_dtop",Pdp_dtop,2},
                    230:        {"dp_homo",Pdp_homo,1},
                    231:        {"dp_dehomo",Pdp_dehomo,1},
                    232:        {"dp_etov",Pdp_etov,1},
                    233:        {"dp_vtoe",Pdp_vtoe,1},
                    234:        {"dp_dtov",Pdp_dtov,1},
                    235:        {"dp_mdtod",Pdp_mdtod,1},
                    236:        {"dp_mod",Pdp_mod,3},
                    237:        {"dp_rat",Pdp_rat,1},
1.53      noro      238:        {"dp_ltod",Pdp_ltod,-2},
1.8       noro      239:
                    240:        /* criteria */
                    241:        {"dp_cri1",Pdp_cri1,2},
                    242:        {"dp_cri2",Pdp_cri2,2},
                    243:        {"dp_criB",Pdp_criB,3},
                    244:
                    245:        /* simple operation */
                    246:        {"dp_subd",Pdp_subd,2},
                    247:        {"dp_lcm",Pdp_lcm,2},
                    248:        {"dp_hm",Pdp_hm,1},
                    249:        {"dp_ht",Pdp_ht,1},
                    250:        {"dp_hc",Pdp_hc,1},
1.52      noro      251:        {"dpv_hm",Pdpv_hm,1},
                    252:        {"dpv_ht",Pdpv_ht,1},
                    253:        {"dpv_hc",Pdpv_hc,1},
1.8       noro      254:        {"dp_rest",Pdp_rest,1},
1.49      noro      255:        {"dp_initial_term",Pdp_initial_term,1},
                    256:        {"dp_order",Pdp_order,1},
1.80      noro      257:        {"dp_symb_add",Pdp_symb_add,2},
1.8       noro      258:
                    259:        /* degree and size */
                    260:        {"dp_td",Pdp_td,1},
                    261:        {"dp_mag",Pdp_mag,1},
                    262:        {"dp_sugar",Pdp_sugar,1},
1.30      ohara     263:        {"dp_set_sugar",Pdp_set_sugar,2},
1.8       noro      264:
                    265:        /* misc */
                    266:        {"dp_mbase",Pdp_mbase,1},
                    267:        {"dp_redble",Pdp_redble,2},
                    268:        {"dp_sep",Pdp_sep,2},
                    269:        {"dp_idiv",Pdp_idiv,2},
                    270:        {"dp_tdiv",Pdp_tdiv,2},
                    271:        {"dp_minp",Pdp_minp,2},
1.68      noro      272:        {"dp_compute_last_w",Pdp_compute_last_w,5},
1.74      noro      273:        {"dp_compute_last_t",Pdp_compute_last_t,5},
1.70      noro      274:        {"dp_compute_essential_df",Pdp_compute_essential_df,2},
1.82      noro      275:        {"dp_mono_raddec",Pdp_mono_raddec,2},
1.84      noro      276:        {"dp_mono_reduce",Pdp_mono_reduce,2},
1.8       noro      277:
                    278:        {0,0,0}
1.1       noro      279: };
1.44      noro      280:
1.68      noro      281: NODE compute_last_w(NODE g,NODE gh,int n,int **v,int row1,int **m1,int row2,int **m2);
1.74      noro      282: Q compute_last_t(NODE g,NODE gh,Q t,VECT w1,VECT w2,NODE *homo,VECT *wp);
                    283:
                    284: void Pdp_compute_last_t(NODE arg,LIST *rp)
                    285: {
                    286:        NODE g,gh,homo,n;
                    287:        LIST hlist;
                    288:        VECT v1,v2,w;
                    289:        Q t;
                    290:
                    291:        g = (NODE)BDY((LIST)ARG0(arg));
                    292:        gh = (NODE)BDY((LIST)ARG1(arg));
                    293:        t = (Q)ARG2(arg);
                    294:        v1 = (VECT)ARG3(arg);
                    295:        v2 = (VECT)ARG4(arg);
                    296:        t = compute_last_t(g,gh,t,v1,v2,&homo,&w);
                    297:        MKLIST(hlist,homo);
                    298:        n = mknode(3,t,w,hlist);
                    299:        MKLIST(*rp,n);
                    300: }
1.68      noro      301:
                    302: void Pdp_compute_last_w(NODE arg,LIST *rp)
                    303: {
                    304:        NODE g,gh,r;
                    305:        VECT w,rv;
                    306:        LIST l;
                    307:        MAT w1,w2;
                    308:        int row1,row2,i,j,n;
                    309:        int *v;
                    310:        int **m1,**m2;
                    311:        Q q;
                    312:
                    313:        g = (NODE)BDY((LIST)ARG0(arg));
                    314:        gh = (NODE)BDY((LIST)ARG1(arg));
                    315:        w = (VECT)ARG2(arg);
                    316:        w1 = (MAT)ARG3(arg);
                    317:        w2 = (MAT)ARG4(arg);
                    318:        n = w1->col;
                    319:        row1 = w1->row;
                    320:        row2 = w2->row;
                    321:        if ( w ) {
                    322:                v = W_ALLOC(n);
                    323:                for ( i = 0; i < n; i++ ) v[i] = QTOS((Q)w->body[i]);
                    324:        } else v = 0;
                    325:        m1 = almat(row1,n);
                    326:        for ( i = 0; i < row1; i++ )
                    327:                for ( j = 0; j < n; j++ ) m1[i][j] = QTOS((Q)w1->body[i][j]);
                    328:        m2 = almat(row2,n);
                    329:        for ( i = 0; i < row2; i++ )
                    330:                for ( j = 0; j < n; j++ ) m2[i][j] = QTOS((Q)w2->body[i][j]);
                    331:        r = compute_last_w(g,gh,n,&v,row1,m1,row2,m2);
                    332:        if ( !r ) *rp = 0;
                    333:        else {
                    334:                MKVECT(rv,n);
                    335:                for ( i = 0; i < n; i++ ) {
                    336:                        STOQ(v[i],q); rv->body[i] = (pointer)q;
                    337:                }
                    338:                MKLIST(l,r);
                    339:                r = mknode(2,rv,l);
                    340:                MKLIST(*rp,r);
                    341:        }
                    342: }
                    343:
1.70      noro      344: NODE compute_essential_df(DP *g,DP *gh,int n);
                    345:
                    346: void Pdp_compute_essential_df(NODE arg,LIST *rp)
                    347: {
                    348:        VECT g,gh;
                    349:        NODE r;
                    350:
                    351:        g = (VECT)ARG0(arg);
                    352:        gh = (VECT)ARG1(arg);
                    353:        r = (NODE)compute_essential_df((DP *)BDY(g),(DP *)BDY(gh),g->len);
                    354:        MKLIST(*rp,r);
                    355: }
                    356:
1.66      noro      357: void Pdp_inv_or_split(arg,rp)
                    358: NODE arg;
                    359: Obj *rp;
                    360: {
                    361:        NODE gb,newgb;
                    362:        DP f,inv;
                    363:        struct order_spec *spec;
                    364:        LIST list;
                    365:
                    366:        do_weyl = 0; dp_fcoeffs = 0;
                    367:        asir_assert(ARG0(arg),O_LIST,"dp_inv_or_split");
                    368:        asir_assert(ARG1(arg),O_DP,"dp_inv_or_split");
                    369:        if ( !create_order_spec(0,(Obj)ARG2(arg),&spec) )
                    370:                error("dp_inv_or_split : invalid order specification");
                    371:        gb = BDY((LIST)ARG0(arg));
                    372:        f = (DP)ARG1(arg);
                    373:        newgb = (NODE)dp_inv_or_split(gb,f,spec,&inv);
                    374:        if ( !newgb ) {
                    375:                /* invertible */
                    376:                *rp = (Obj)inv;
                    377:        } else {
                    378:                MKLIST(list,newgb);
                    379:                *rp = (Obj)list;
                    380:        }
                    381: }
                    382:
1.44      noro      383: void Pdp_sort(arg,rp)
                    384: NODE arg;
                    385: DP *rp;
                    386: {
                    387:        dp_sort((DP)ARG0(arg),rp);
                    388: }
1.1       noro      389:
1.8       noro      390: void Pdp_mdtod(arg,rp)
                    391: NODE arg;
                    392: DP *rp;
                    393: {
                    394:        MP m,mr,mr0;
                    395:        DP p;
                    396:        P t;
                    397:
                    398:        p = (DP)ARG0(arg);
                    399:        if ( !p )
                    400:                *rp = 0;
                    401:        else {
                    402:                for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
                    403:                        mptop(m->c,&t); NEXTMP(mr0,mr); mr->c = t; mr->dl = m->dl;
                    404:                }
                    405:                NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
                    406:        }
                    407: }
                    408:
                    409: void Pdp_sep(arg,rp)
                    410: NODE arg;
                    411: VECT *rp;
                    412: {
                    413:        DP p,r;
                    414:        MP m,t;
                    415:        MP *w0,*w;
                    416:        int i,n,d,nv,sugar;
                    417:        VECT v;
                    418:        pointer *pv;
                    419:
                    420:        p = (DP)ARG0(arg); m = BDY(p);
                    421:        d = QTOS((Q)ARG1(arg));
                    422:        for ( t = m, n = 0; t; t = NEXT(t), n++ );
                    423:        if ( d > n )
                    424:                d = n;
                    425:        MKVECT(v,d); *rp = v;
                    426:        pv = BDY(v); nv = p->nv; sugar = p->sugar;
                    427:        w0 = (MP *)MALLOC(d*sizeof(MP)); bzero(w0,d*sizeof(MP));
                    428:        w = (MP *)MALLOC(d*sizeof(MP)); bzero(w,d*sizeof(MP));
                    429:        for ( t = BDY(p), i = 0; t; t = NEXT(t), i++, i %= d  ) {
                    430:                NEXTMP(w0[i],w[i]); w[i]->c = t->c; w[i]->dl = t->dl;
                    431:        }
                    432:        for ( i = 0; i < d; i++ ) {
                    433:                NEXT(w[i]) = 0; MKDP(nv,w0[i],r); r->sugar = sugar;
                    434:                pv[i] = (pointer)r;
                    435:        }
                    436: }
                    437:
                    438: void Pdp_idiv(arg,rp)
                    439: NODE arg;
                    440: DP *rp;
                    441: {
                    442:        dp_idiv((DP)ARG0(arg),(Q)ARG1(arg),rp);
                    443: }
                    444:
                    445: void Pdp_cont(arg,rp)
                    446: NODE arg;
                    447: Q *rp;
                    448: {
                    449:        dp_cont((DP)ARG0(arg),rp);
                    450: }
                    451:
                    452: void Pdp_dtov(arg,rp)
                    453: NODE arg;
                    454: VECT *rp;
                    455: {
                    456:        dp_dtov((DP)ARG0(arg),rp);
                    457: }
                    458:
                    459: void Pdp_mbase(arg,rp)
                    460: NODE arg;
                    461: LIST *rp;
                    462: {
                    463:        NODE mb;
                    464:
                    465:        asir_assert(ARG0(arg),O_LIST,"dp_mbase");
                    466:        dp_mbase(BDY((LIST)ARG0(arg)),&mb);
                    467:        MKLIST(*rp,mb);
                    468: }
                    469:
                    470: void Pdp_etov(arg,rp)
                    471: NODE arg;
                    472: VECT *rp;
                    473: {
                    474:        DP dp;
                    475:        int n,i;
                    476:        int *d;
                    477:        VECT v;
                    478:        Q t;
                    479:
                    480:        dp = (DP)ARG0(arg);
                    481:        asir_assert(dp,O_DP,"dp_etov");
                    482:        n = dp->nv; d = BDY(dp)->dl->d;
                    483:        MKVECT(v,n);
                    484:        for ( i = 0; i < n; i++ ) {
                    485:                STOQ(d[i],t); v->body[i] = (pointer)t;
                    486:        }
                    487:        *rp = v;
                    488: }
                    489:
                    490: void Pdp_vtoe(arg,rp)
                    491: NODE arg;
                    492: DP *rp;
                    493: {
                    494:        DP dp;
                    495:        DL dl;
                    496:        MP m;
                    497:        int n,i,td;
                    498:        int *d;
                    499:        VECT v;
                    500:
                    501:        v = (VECT)ARG0(arg);
                    502:        asir_assert(v,O_VECT,"dp_vtoe");
                    503:        n = v->len;
                    504:        NEWDL(dl,n); d = dl->d;
                    505:        for ( i = 0, td = 0; i < n; i++ ) {
1.24      noro      506:                d[i] = QTOS((Q)(v->body[i])); td += MUL_WEIGHT(d[i],i);
1.8       noro      507:        }
                    508:        dl->td = td;
                    509:        NEWMP(m); m->dl = dl; m->c = (P)ONE; NEXT(m) = 0;
                    510:        MKDP(n,m,dp); dp->sugar = td;
                    511:        *rp = dp;
                    512: }
                    513:
                    514: void Pdp_lnf_mod(arg,rp)
                    515: NODE arg;
                    516: LIST *rp;
                    517: {
                    518:        DP r1,r2;
                    519:        NODE b,g,n;
                    520:        int mod;
                    521:
                    522:        asir_assert(ARG0(arg),O_LIST,"dp_lnf_mod");
                    523:        asir_assert(ARG1(arg),O_LIST,"dp_lnf_mod");
                    524:        asir_assert(ARG2(arg),O_N,"dp_lnf_mod");
                    525:        b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg));
                    526:        mod = QTOS((Q)ARG2(arg));
                    527:        dp_lnf_mod((DP)BDY(b),(DP)BDY(NEXT(b)),g,mod,&r1,&r2);
                    528:        NEWNODE(n); BDY(n) = (pointer)r1;
                    529:        NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2;
                    530:        NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
                    531: }
                    532:
1.16      noro      533: void Pdp_lnf_f(arg,rp)
                    534: NODE arg;
                    535: LIST *rp;
                    536: {
                    537:        DP r1,r2;
                    538:        NODE b,g,n;
                    539:
                    540:        asir_assert(ARG0(arg),O_LIST,"dp_lnf_f");
                    541:        asir_assert(ARG1(arg),O_LIST,"dp_lnf_f");
                    542:        b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg));
                    543:        dp_lnf_f((DP)BDY(b),(DP)BDY(NEXT(b)),g,&r1,&r2);
                    544:        NEWNODE(n); BDY(n) = (pointer)r1;
                    545:        NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2;
                    546:        NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
                    547: }
                    548:
1.8       noro      549: void Pdp_nf_tab_mod(arg,rp)
                    550: NODE arg;
                    551: DP *rp;
                    552: {
                    553:        asir_assert(ARG0(arg),O_DP,"dp_nf_tab_mod");
                    554:        asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_mod");
                    555:        asir_assert(ARG2(arg),O_N,"dp_nf_tab_mod");
                    556:        dp_nf_tab_mod((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)),
                    557:                QTOS((Q)ARG2(arg)),rp);
1.28      noro      558: }
                    559:
                    560: void Pdp_nf_tab_f(arg,rp)
                    561: NODE arg;
                    562: DP *rp;
                    563: {
                    564:        asir_assert(ARG0(arg),O_DP,"dp_nf_tab_f");
                    565:        asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_f");
                    566:        dp_nf_tab_f((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)),rp);
1.8       noro      567: }
1.1       noro      568:
                    569: void Pdp_ord(arg,rp)
                    570: NODE arg;
                    571: Obj *rp;
                    572: {
1.46      noro      573:        struct order_spec *spec;
1.51      noro      574:        LIST v;
                    575:        struct oLIST f;
                    576:        Num homo;
                    577:        int modular;
                    578:
                    579:        f.id = O_LIST; f.body = 0;
1.59      noro      580:        if ( !arg && !current_option )
1.46      noro      581:                *rp = dp_current_spec->obj;
1.1       noro      582:        else {
1.53      noro      583:                if ( current_option )
                    584:                        parse_gr_option(&f,current_option,&v,&homo,&modular,&spec);
1.51      noro      585:                else if ( !create_order_spec(0,(Obj)ARG0(arg),&spec) )
                    586:                        error("dp_ord : invalid order specification");
1.46      noro      587:                initd(spec); *rp = spec->obj;
1.1       noro      588:        }
                    589: }
                    590:
                    591: void Pdp_ptod(arg,rp)
                    592: NODE arg;
                    593: DP *rp;
                    594: {
1.53      noro      595:        P p;
1.1       noro      596:        NODE n;
                    597:        VL vl,tvl;
1.53      noro      598:        struct oLIST f;
                    599:        int ac;
                    600:        LIST v;
                    601:        Num homo;
                    602:        int modular;
                    603:        struct order_spec *ord;
1.1       noro      604:
                    605:        asir_assert(ARG0(arg),O_P,"dp_ptod");
1.53      noro      606:        p = (P)ARG0(arg);
                    607:        ac = argc(arg);
                    608:        if ( ac == 1 ) {
                    609:                if ( current_option ) {
                    610:                        f.id = O_LIST; f.body = mknode(1,p);
                    611:                        parse_gr_option(&f,current_option,&v,&homo,&modular,&ord);
1.54      noro      612:                        initd(ord);
1.53      noro      613:                } else
                    614:                        error("dp_ptod : invalid argument");
                    615:        } else {
                    616:                asir_assert(ARG1(arg),O_LIST,"dp_ptod");
                    617:                v = (LIST)ARG1(arg);
                    618:        }
                    619:        for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) {
1.1       noro      620:                if ( !vl ) {
                    621:                        NEWVL(vl); tvl = vl;
                    622:                } else {
                    623:                        NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
                    624:                }
                    625:                VR(tvl) = VR((P)BDY(n));
                    626:        }
                    627:        if ( vl )
                    628:                NEXT(tvl) = 0;
1.53      noro      629:        ptod(CO,vl,p,rp);
1.64      noro      630: }
                    631:
                    632: void Phomogenize(arg,rp)
                    633: NODE arg;
                    634: P *rp;
                    635: {
                    636:        P p;
                    637:        DP d,h;
                    638:        NODE n;
                    639:        V hv;
                    640:        VL vl,tvl,last;
                    641:        struct oLIST f;
                    642:        LIST v;
                    643:
                    644:        asir_assert(ARG0(arg),O_P,"homogenize");
                    645:        p = (P)ARG0(arg);
                    646:        asir_assert(ARG1(arg),O_LIST,"homogenize");
                    647:        v = (LIST)ARG1(arg);
                    648:        asir_assert(ARG2(arg),O_P,"homogenize");
                    649:        hv = VR((P)ARG2(arg));
                    650:        for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) {
                    651:                if ( !vl ) {
                    652:                        NEWVL(vl); tvl = vl;
                    653:                } else {
                    654:                        NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
                    655:                }
                    656:                VR(tvl) = VR((P)BDY(n));
                    657:        }
                    658:        if ( vl ) {
                    659:                last = tvl;
                    660:                NEXT(tvl) = 0;
                    661:        }
                    662:        ptod(CO,vl,p,&d);
                    663:        dp_homo(d,&h);
                    664:        NEWVL(NEXT(last)); last = NEXT(last);
                    665:        VR(last) = hv; NEXT(last) = 0;
                    666:        dtop(CO,vl,h,rp);
1.1       noro      667: }
                    668:
1.52      noro      669: void Pdp_ltod(arg,rp)
                    670: NODE arg;
                    671: DPV *rp;
                    672: {
                    673:        NODE n;
                    674:        VL vl,tvl;
1.53      noro      675:        LIST f,v;
                    676:        int sugar,i,len,ac,modular;
                    677:        Num homo;
                    678:        struct order_spec *ord;
1.52      noro      679:        DP *e;
                    680:        NODE nd,t;
                    681:
1.53      noro      682:        ac = argc(arg);
1.52      noro      683:        asir_assert(ARG0(arg),O_LIST,"dp_ptod");
1.53      noro      684:        f = (LIST)ARG0(arg);
                    685:        if ( ac == 1 ) {
                    686:                if ( current_option ) {
                    687:                        parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
1.54      noro      688:                        initd(ord);
1.53      noro      689:                } else
                    690:                        error("dp_ltod : invalid argument");
                    691:        } else {
                    692:                asir_assert(ARG1(arg),O_LIST,"dp_ptod");
                    693:                v = (LIST)ARG1(arg);
                    694:        }
                    695:        for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) {
1.52      noro      696:                if ( !vl ) {
                    697:                        NEWVL(vl); tvl = vl;
                    698:                } else {
                    699:                        NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
                    700:                }
                    701:                VR(tvl) = VR((P)BDY(n));
                    702:        }
                    703:        if ( vl )
                    704:                NEXT(tvl) = 0;
1.53      noro      705:
                    706:        nd = BDY(f);
1.52      noro      707:        len = length(nd);
                    708:        e = (DP *)MALLOC(len*sizeof(DP));
                    709:        sugar = 0;
                    710:        for ( i = 0, t = nd; i < len; i++, t = NEXT(t) ) {
                    711:                ptod(CO,vl,(P)BDY(t),&e[i]);
                    712:                if ( e[i] )
                    713:                        sugar = MAX(sugar,e[i]->sugar);
                    714:        }
                    715:        MKDPV(len,e,*rp);
                    716: }
                    717:
1.1       noro      718: void Pdp_dtop(arg,rp)
                    719: NODE arg;
                    720: P *rp;
                    721: {
                    722:        NODE n;
                    723:        VL vl,tvl;
                    724:
                    725:        asir_assert(ARG0(arg),O_DP,"dp_dtop");
                    726:        asir_assert(ARG1(arg),O_LIST,"dp_dtop");
                    727:        for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {
                    728:                if ( !vl ) {
                    729:                        NEWVL(vl); tvl = vl;
                    730:                } else {
                    731:                        NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
                    732:                }
                    733:                VR(tvl) = VR((P)BDY(n));
                    734:        }
                    735:        if ( vl )
                    736:                NEXT(tvl) = 0;
                    737:        dtop(CO,vl,(DP)ARG0(arg),rp);
                    738: }
                    739:
                    740: extern LIST Dist;
                    741:
                    742: void Pdp_ptozp(arg,rp)
                    743: NODE arg;
1.60      ohara     744: Obj *rp;
1.1       noro      745: {
1.60      ohara     746:        Q t;
                    747:     NODE tt,p;
                    748:     NODE n,n0;
                    749:     char *key;
                    750:        DP pp;
                    751:        LIST list;
                    752:     int get_factor=0;
                    753:
1.1       noro      754:        asir_assert(ARG0(arg),O_DP,"dp_ptozp");
1.60      ohara     755:
                    756:     /* analyze the option */
                    757:     if ( current_option ) {
                    758:       for ( tt = current_option; tt; tt = NEXT(tt) ) {
                    759:         p = BDY((LIST)BDY(tt));
                    760:         key = BDY((STRING)BDY(p));
                    761:         /*  value = (Obj)BDY(NEXT(p)); */
                    762:         if ( !strcmp(key,"factor") )  get_factor=1;
                    763:         else {
                    764:           error("ptozp: unknown option.");
                    765:         }
                    766:       }
                    767:     }
                    768:
                    769:        dp_ptozp3((DP)ARG0(arg),&t,&pp);
                    770:
                    771:     /* printexpr(NULL,t); */
                    772:        /* if the option factor is given, then it returns the answer
                    773:        in the format [zpoly, num] where num*zpoly is equal to the argument.*/
                    774:     if (get_factor) {
                    775:          n0 = mknode(2,pp,t);
                    776:       MKLIST(list,n0);
                    777:          *rp = (Obj)list;
                    778:     } else
                    779:       *rp = (Obj)pp;
1.1       noro      780: }
                    781:
                    782: void Pdp_ptozp2(arg,rp)
                    783: NODE arg;
                    784: LIST *rp;
                    785: {
                    786:        DP p0,p1,h,r;
                    787:        NODE n0;
                    788:
                    789:        p0 = (DP)ARG0(arg); p1 = (DP)ARG1(arg);
                    790:        asir_assert(p0,O_DP,"dp_ptozp2");
                    791:        asir_assert(p1,O_DP,"dp_ptozp2");
1.10      noro      792:        dp_ptozp2(p0,p1,&h,&r);
1.1       noro      793:        NEWNODE(n0); BDY(n0) = (pointer)h;
                    794:        NEWNODE(NEXT(n0)); BDY(NEXT(n0)) = (pointer)r;
                    795:        NEXT(NEXT(n0)) = 0;
                    796:        MKLIST(*rp,n0);
                    797: }
                    798:
                    799: void Pdp_prim(arg,rp)
                    800: NODE arg;
                    801: DP *rp;
                    802: {
                    803:        DP t;
                    804:
                    805:        asir_assert(ARG0(arg),O_DP,"dp_prim");
                    806:        dp_prim((DP)ARG0(arg),&t); dp_ptozp(t,rp);
                    807: }
                    808:
                    809: void Pdp_mod(arg,rp)
                    810: NODE arg;
                    811: DP *rp;
                    812: {
                    813:        DP p;
                    814:        int mod;
                    815:        NODE subst;
                    816:
                    817:        asir_assert(ARG0(arg),O_DP,"dp_mod");
                    818:        asir_assert(ARG1(arg),O_N,"dp_mod");
                    819:        asir_assert(ARG2(arg),O_LIST,"dp_mod");
                    820:        p = (DP)ARG0(arg); mod = QTOS((Q)ARG1(arg));
                    821:        subst = BDY((LIST)ARG2(arg));
                    822:        dp_mod(p,mod,subst,rp);
                    823: }
                    824:
                    825: void Pdp_rat(arg,rp)
                    826: NODE arg;
                    827: DP *rp;
                    828: {
                    829:        asir_assert(ARG0(arg),O_DP,"dp_rat");
                    830:        dp_rat((DP)ARG0(arg),rp);
                    831: }
                    832:
1.9       noro      833: extern int DP_Multiple;
                    834:
1.1       noro      835: void Pdp_nf(arg,rp)
                    836: NODE arg;
                    837: DP *rp;
                    838: {
                    839:        NODE b;
                    840:        DP *ps;
                    841:        DP g;
                    842:        int full;
                    843:
1.61      noro      844:        do_weyl = 0; dp_fcoeffs = 0;
1.1       noro      845:        asir_assert(ARG0(arg),O_LIST,"dp_nf");
                    846:        asir_assert(ARG1(arg),O_DP,"dp_nf");
                    847:        asir_assert(ARG2(arg),O_VECT,"dp_nf");
                    848:        asir_assert(ARG3(arg),O_N,"dp_nf");
                    849:        if ( !(g = (DP)ARG1(arg)) ) {
                    850:                *rp = 0; return;
                    851:        }
                    852:        b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
                    853:        full = (Q)ARG3(arg) ? 1 : 0;
1.16      noro      854:        dp_nf_z(b,g,ps,full,DP_Multiple,rp);
1.1       noro      855: }
                    856:
1.11      noro      857: void Pdp_weyl_nf(arg,rp)
                    858: NODE arg;
                    859: DP *rp;
                    860: {
                    861:        NODE b;
                    862:        DP *ps;
                    863:        DP g;
                    864:        int full;
                    865:
                    866:        asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf");
                    867:        asir_assert(ARG1(arg),O_DP,"dp_weyl_nf");
                    868:        asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf");
                    869:        asir_assert(ARG3(arg),O_N,"dp_weyl_nf");
                    870:        if ( !(g = (DP)ARG1(arg)) ) {
                    871:                *rp = 0; return;
                    872:        }
                    873:        b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
                    874:        full = (Q)ARG3(arg) ? 1 : 0;
1.12      noro      875:        do_weyl = 1;
1.16      noro      876:        dp_nf_z(b,g,ps,full,DP_Multiple,rp);
                    877:        do_weyl = 0;
                    878: }
                    879:
                    880: /* nf computation using field operations */
                    881:
                    882: void Pdp_nf_f(arg,rp)
                    883: NODE arg;
                    884: DP *rp;
                    885: {
                    886:        NODE b;
                    887:        DP *ps;
                    888:        DP g;
                    889:        int full;
                    890:
                    891:        do_weyl = 0;
                    892:        asir_assert(ARG0(arg),O_LIST,"dp_nf_f");
                    893:        asir_assert(ARG1(arg),O_DP,"dp_nf_f");
                    894:        asir_assert(ARG2(arg),O_VECT,"dp_nf_f");
                    895:        asir_assert(ARG3(arg),O_N,"dp_nf_f");
                    896:        if ( !(g = (DP)ARG1(arg)) ) {
                    897:                *rp = 0; return;
                    898:        }
                    899:        b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
                    900:        full = (Q)ARG3(arg) ? 1 : 0;
                    901:        dp_nf_f(b,g,ps,full,rp);
                    902: }
                    903:
                    904: void Pdp_weyl_nf_f(arg,rp)
                    905: NODE arg;
                    906: DP *rp;
                    907: {
                    908:        NODE b;
                    909:        DP *ps;
                    910:        DP g;
                    911:        int full;
                    912:
                    913:        asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_f");
                    914:        asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_f");
                    915:        asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_f");
                    916:        asir_assert(ARG3(arg),O_N,"dp_weyl_nf_f");
                    917:        if ( !(g = (DP)ARG1(arg)) ) {
                    918:                *rp = 0; return;
                    919:        }
                    920:        b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
                    921:        full = (Q)ARG3(arg) ? 1 : 0;
                    922:        do_weyl = 1;
                    923:        dp_nf_f(b,g,ps,full,rp);
1.12      noro      924:        do_weyl = 0;
1.11      noro      925: }
                    926:
1.13      noro      927: void Pdp_nf_mod(arg,rp)
                    928: NODE arg;
                    929: DP *rp;
                    930: {
                    931:        NODE b;
                    932:        DP g;
                    933:        DP *ps;
                    934:        int mod,full,ac;
                    935:        NODE n,n0;
                    936:
1.14      noro      937:        do_weyl = 0;
1.13      noro      938:        ac = argc(arg);
1.14      noro      939:        asir_assert(ARG0(arg),O_LIST,"dp_nf_mod");
                    940:        asir_assert(ARG1(arg),O_DP,"dp_nf_mod");
                    941:        asir_assert(ARG2(arg),O_VECT,"dp_nf_mod");
                    942:        asir_assert(ARG3(arg),O_N,"dp_nf_mod");
                    943:        asir_assert(ARG4(arg),O_N,"dp_nf_mod");
1.13      noro      944:        if ( !(g = (DP)ARG1(arg)) ) {
                    945:                *rp = 0; return;
                    946:        }
                    947:        b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
                    948:        full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));
                    949:        for ( n0 = n = 0; b; b = NEXT(b) ) {
                    950:                NEXTNODE(n0,n);
                    951:                BDY(n) = (pointer)QTOS((Q)BDY(b));
                    952:        }
                    953:        if ( n0 )
                    954:                NEXT(n) = 0;
                    955:        dp_nf_mod(n0,g,ps,mod,full,rp);
                    956: }
                    957:
1.1       noro      958: void Pdp_true_nf(arg,rp)
                    959: NODE arg;
                    960: LIST *rp;
                    961: {
                    962:        NODE b,n;
                    963:        DP *ps;
                    964:        DP g;
                    965:        DP nm;
                    966:        P dn;
                    967:        int full;
                    968:
1.61      noro      969:        do_weyl = 0; dp_fcoeffs = 0;
1.1       noro      970:        asir_assert(ARG0(arg),O_LIST,"dp_true_nf");
                    971:        asir_assert(ARG1(arg),O_DP,"dp_true_nf");
                    972:        asir_assert(ARG2(arg),O_VECT,"dp_true_nf");
                    973:        asir_assert(ARG3(arg),O_N,"dp_nf");
                    974:        if ( !(g = (DP)ARG1(arg)) ) {
                    975:                nm = 0; dn = (P)ONE;
                    976:        } else {
                    977:                b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
                    978:                full = (Q)ARG3(arg) ? 1 : 0;
                    979:                dp_true_nf(b,g,ps,full,&nm,&dn);
                    980:        }
                    981:        NEWNODE(n); BDY(n) = (pointer)nm;
                    982:        NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn;
                    983:        NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
                    984: }
                    985:
1.67      noro      986: void Pdp_true_nf_marked(arg,rp)
                    987: NODE arg;
                    988: LIST *rp;
                    989: {
                    990:        NODE b,n;
                    991:        DP *ps,*hps;
                    992:        DP g;
                    993:        DP nm;
1.69      noro      994:        Q cont;
1.67      noro      995:        P dn;
                    996:        int full;
                    997:
                    998:        do_weyl = 0; dp_fcoeffs = 0;
                    999:        asir_assert(ARG0(arg),O_LIST,"dp_true_nf_marked");
                   1000:        asir_assert(ARG1(arg),O_DP,"dp_true_nf_marked");
                   1001:        asir_assert(ARG2(arg),O_VECT,"dp_true_nf_marked");
                   1002:        asir_assert(ARG3(arg),O_VECT,"dp_true_nf_marked");
                   1003:        if ( !(g = (DP)ARG1(arg)) ) {
                   1004:                nm = 0; dn = (P)ONE;
                   1005:        } else {
                   1006:                b = BDY((LIST)ARG0(arg));
                   1007:                ps = (DP *)BDY((VECT)ARG2(arg));
                   1008:                hps = (DP *)BDY((VECT)ARG3(arg));
1.69      noro     1009:                dp_true_nf_marked(b,g,ps,hps,&nm,&cont,&dn);
1.67      noro     1010:        }
1.69      noro     1011:        n = mknode(3,nm,cont,dn);
                   1012:        MKLIST(*rp,n);
1.67      noro     1013: }
                   1014:
1.73      noro     1015: DP *dp_true_nf_and_quotient_marked (NODE b,DP g,DP *ps,DP *hps,DP *rp,P *dnp);
                   1016:
                   1017: void Pdp_true_nf_and_quotient_marked(arg,rp)
                   1018: NODE arg;
                   1019: LIST *rp;
                   1020: {
                   1021:        NODE b,n;
                   1022:        DP *ps,*hps;
                   1023:        DP g;
                   1024:        DP nm;
                   1025:        VECT quo;
                   1026:        P dn;
                   1027:        int full;
                   1028:
                   1029:        do_weyl = 0; dp_fcoeffs = 0;
                   1030:        asir_assert(ARG0(arg),O_LIST,"dp_true_nf_and_quotient_marked");
                   1031:        asir_assert(ARG1(arg),O_DP,"dp_true_nf_and_quotient_marked");
                   1032:        asir_assert(ARG2(arg),O_VECT,"dp_true_nf_and_quotient_marked");
                   1033:        asir_assert(ARG3(arg),O_VECT,"dp_true_nf_and_quotient_marked");
                   1034:        if ( !(g = (DP)ARG1(arg)) ) {
                   1035:                nm = 0; dn = (P)ONE;
                   1036:        } else {
                   1037:                b = BDY((LIST)ARG0(arg));
                   1038:                ps = (DP *)BDY((VECT)ARG2(arg));
                   1039:                hps = (DP *)BDY((VECT)ARG3(arg));
                   1040:                NEWVECT(quo); quo->len = ((VECT)ARG2(arg))->len;
                   1041:                quo->body = (pointer *)dp_true_nf_and_quotient_marked(b,g,ps,hps,&nm,&dn);
                   1042:        }
                   1043:        n = mknode(3,nm,dn,quo);
                   1044:        MKLIST(*rp,n);
                   1045: }
                   1046:
1.79      noro     1047: DP *dp_true_nf_and_quotient_marked_mod (NODE b,DP g,DP *ps,DP *hps,int mod,DP *rp,P *dnp);
                   1048:
                   1049: void Pdp_true_nf_and_quotient_marked_mod(arg,rp)
                   1050: NODE arg;
                   1051: LIST *rp;
                   1052: {
                   1053:        NODE b,n;
                   1054:        DP *ps,*hps;
                   1055:        DP g;
                   1056:        DP nm;
                   1057:        VECT quo;
                   1058:        P dn;
                   1059:        int full,mod;
                   1060:
                   1061:        do_weyl = 0; dp_fcoeffs = 0;
                   1062:        asir_assert(ARG0(arg),O_LIST,"dp_true_nf_and_quotient_marked_mod");
                   1063:        asir_assert(ARG1(arg),O_DP,"dp_true_nf_and_quotient_marked_mod");
                   1064:        asir_assert(ARG2(arg),O_VECT,"dp_true_nf_and_quotient_marked_mod");
                   1065:        asir_assert(ARG3(arg),O_VECT,"dp_true_nf_and_quotient_marked_mod");
                   1066:        asir_assert(ARG4(arg),O_N,"dp_true_nf_and_quotient_marked_mod");
                   1067:        if ( !(g = (DP)ARG1(arg)) ) {
                   1068:                nm = 0; dn = (P)ONE;
                   1069:        } else {
                   1070:                b = BDY((LIST)ARG0(arg));
                   1071:                ps = (DP *)BDY((VECT)ARG2(arg));
                   1072:                hps = (DP *)BDY((VECT)ARG3(arg));
                   1073:                mod = QTOS((Q)ARG4(arg));
                   1074:                NEWVECT(quo); quo->len = ((VECT)ARG2(arg))->len;
                   1075:                quo->body = (pointer *)dp_true_nf_and_quotient_marked_mod(b,g,ps,hps,mod,&nm,&dn);
                   1076:        }
                   1077:        n = mknode(3,nm,dn,quo);
                   1078:        MKLIST(*rp,n);
                   1079: }
                   1080:
1.70      noro     1081: void Pdp_true_nf_marked_mod(arg,rp)
                   1082: NODE arg;
                   1083: LIST *rp;
                   1084: {
                   1085:        NODE b,n;
                   1086:        DP *ps,*hps;
                   1087:        DP g;
                   1088:        DP nm;
                   1089:        P dn;
                   1090:        int mod;
                   1091:
                   1092:        do_weyl = 0; dp_fcoeffs = 0;
                   1093:        asir_assert(ARG0(arg),O_LIST,"dp_true_nf_marked_mod");
                   1094:        asir_assert(ARG1(arg),O_DP,"dp_true_nf_marked_mod");
                   1095:        asir_assert(ARG2(arg),O_VECT,"dp_true_nf_marked_mod");
                   1096:        asir_assert(ARG3(arg),O_VECT,"dp_true_nf_marked_mod");
                   1097:        asir_assert(ARG4(arg),O_N,"dp_true_nf_marked_mod");
                   1098:        if ( !(g = (DP)ARG1(arg)) ) {
                   1099:                nm = 0; dn = (P)ONE;
                   1100:        } else {
                   1101:                b = BDY((LIST)ARG0(arg));
                   1102:                ps = (DP *)BDY((VECT)ARG2(arg));
                   1103:                hps = (DP *)BDY((VECT)ARG3(arg));
                   1104:                mod = QTOS((Q)ARG4(arg));
                   1105:                dp_true_nf_marked_mod(b,g,ps,hps,mod,&nm,&dn);
                   1106:        }
                   1107:        n = mknode(2,nm,dn);
                   1108:        MKLIST(*rp,n);
                   1109: }
                   1110:
1.13      noro     1111: void Pdp_weyl_nf_mod(arg,rp)
1.8       noro     1112: NODE arg;
                   1113: DP *rp;
                   1114: {
                   1115:        NODE b;
                   1116:        DP g;
                   1117:        DP *ps;
                   1118:        int mod,full,ac;
1.9       noro     1119:        NODE n,n0;
1.8       noro     1120:
                   1121:        ac = argc(arg);
1.14      noro     1122:        asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_mod");
                   1123:        asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_mod");
                   1124:        asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_mod");
                   1125:        asir_assert(ARG3(arg),O_N,"dp_weyl_nf_mod");
                   1126:        asir_assert(ARG4(arg),O_N,"dp_weyl_nf_mod");
1.8       noro     1127:        if ( !(g = (DP)ARG1(arg)) ) {
                   1128:                *rp = 0; return;
                   1129:        }
                   1130:        b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
                   1131:        full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));
1.9       noro     1132:        for ( n0 = n = 0; b; b = NEXT(b) ) {
                   1133:                NEXTNODE(n0,n);
                   1134:                BDY(n) = (pointer)QTOS((Q)BDY(b));
                   1135:        }
                   1136:        if ( n0 )
                   1137:                NEXT(n) = 0;
1.13      noro     1138:        do_weyl = 1;
                   1139:        dp_nf_mod(n0,g,ps,mod,full,rp);
                   1140:        do_weyl = 0;
1.8       noro     1141: }
                   1142:
                   1143: void Pdp_true_nf_mod(arg,rp)
                   1144: NODE arg;
                   1145: LIST *rp;
                   1146: {
                   1147:        NODE b;
                   1148:        DP g,nm;
                   1149:        P dn;
                   1150:        DP *ps;
                   1151:        int mod,full;
                   1152:        NODE n;
                   1153:
1.11      noro     1154:        do_weyl = 0;
1.8       noro     1155:        asir_assert(ARG0(arg),O_LIST,"dp_nf_mod");
                   1156:        asir_assert(ARG1(arg),O_DP,"dp_nf_mod");
                   1157:        asir_assert(ARG2(arg),O_VECT,"dp_nf_mod");
                   1158:        asir_assert(ARG3(arg),O_N,"dp_nf_mod");
                   1159:        asir_assert(ARG4(arg),O_N,"dp_nf_mod");
                   1160:        if ( !(g = (DP)ARG1(arg)) ) {
                   1161:                nm = 0; dn = (P)ONEM;
                   1162:        } else {
                   1163:                b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
                   1164:                full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));
                   1165:                dp_true_nf_mod(b,g,ps,mod,full,&nm,&dn);
                   1166:        }
                   1167:        NEWNODE(n); BDY(n) = (pointer)nm;
                   1168:        NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn;
                   1169:        NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
1.1       noro     1170: }
                   1171:
                   1172: void Pdp_tdiv(arg,rp)
                   1173: NODE arg;
                   1174: DP *rp;
                   1175: {
                   1176:        MP m,mr,mr0;
                   1177:        DP p;
                   1178:        Q c;
                   1179:        N d,q,r;
                   1180:        int sgn;
                   1181:
                   1182:        asir_assert(ARG0(arg),O_DP,"dp_tdiv");
                   1183:        asir_assert(ARG1(arg),O_N,"dp_tdiv");
                   1184:        p = (DP)ARG0(arg); d = NM((Q)ARG1(arg)); sgn = SGN((Q)ARG1(arg));
                   1185:        if ( !p )
                   1186:                *rp = 0;
                   1187:        else {
                   1188:                for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
                   1189:                        divn(NM((Q)m->c),d,&q,&r);
                   1190:                        if ( r ) {
                   1191:                                *rp = 0; return;
                   1192:                        } else {
                   1193:                                NEXTMP(mr0,mr); NTOQ(q,SGN((Q)m->c)*sgn,c);
                   1194:                                mr->c = (P)c; mr->dl = m->dl;
                   1195:                        }
                   1196:                }
                   1197:                NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
                   1198:        }
                   1199: }
                   1200:
                   1201: void Pdp_red_coef(arg,rp)
                   1202: NODE arg;
                   1203: DP *rp;
                   1204: {
                   1205:        MP m,mr,mr0;
                   1206:        P q,r;
                   1207:        DP p;
                   1208:        P mod;
                   1209:
                   1210:        p = (DP)ARG0(arg); mod = (P)ARG1(arg);
                   1211:        asir_assert(p,O_DP,"dp_red_coef");
                   1212:        asir_assert(mod,O_P,"dp_red_coef");
                   1213:        if ( !p )
                   1214:                *rp = 0;
                   1215:        else {
                   1216:                for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
                   1217:                        divsrp(CO,m->c,mod,&q,&r);
                   1218:                        if ( r ) {
                   1219:                                NEXTMP(mr0,mr); mr->c = r; mr->dl = m->dl;
                   1220:                        }
                   1221:                }
                   1222:                if ( mr0 ) {
                   1223:                        NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
                   1224:                } else
                   1225:                        *rp = 0;
                   1226:        }
                   1227: }
                   1228:
                   1229: void Pdp_redble(arg,rp)
                   1230: NODE arg;
                   1231: Q *rp;
                   1232: {
                   1233:        asir_assert(ARG0(arg),O_DP,"dp_redble");
                   1234:        asir_assert(ARG1(arg),O_DP,"dp_redble");
                   1235:        if ( dp_redble((DP)ARG0(arg),(DP)ARG1(arg)) )
                   1236:                *rp = ONE;
                   1237:        else
                   1238:                *rp = 0;
                   1239: }
                   1240:
                   1241: void Pdp_red_mod(arg,rp)
                   1242: NODE arg;
                   1243: LIST *rp;
                   1244: {
                   1245:        DP h,r;
                   1246:        P dmy;
                   1247:        NODE n;
                   1248:
1.11      noro     1249:        do_weyl = 0;
1.1       noro     1250:        asir_assert(ARG0(arg),O_DP,"dp_red_mod");
                   1251:        asir_assert(ARG1(arg),O_DP,"dp_red_mod");
                   1252:        asir_assert(ARG2(arg),O_DP,"dp_red_mod");
                   1253:        asir_assert(ARG3(arg),O_N,"dp_red_mod");
                   1254:        dp_red_mod((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),QTOS((Q)ARG3(arg)),
                   1255:                &h,&r,&dmy);
                   1256:        NEWNODE(n); BDY(n) = (pointer)h;
                   1257:        NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r;
                   1258:        NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
                   1259: }
1.13      noro     1260:
1.1       noro     1261: void Pdp_subd(arg,rp)
                   1262: NODE arg;
                   1263: DP *rp;
                   1264: {
                   1265:        DP p1,p2;
                   1266:
                   1267:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
                   1268:        asir_assert(p1,O_DP,"dp_subd");
                   1269:        asir_assert(p2,O_DP,"dp_subd");
                   1270:        dp_subd(p1,p2,rp);
                   1271: }
                   1272:
1.80      noro     1273: void Pdp_symb_add(arg,rp)
                   1274: NODE arg;
                   1275: DP *rp;
                   1276: {
                   1277:        DP p1,p2,r;
                   1278:        NODE s0;
                   1279:        MP mp0,mp;
                   1280:        int nv;
                   1281:
                   1282:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
                   1283:        asir_assert(p1,O_DP,"dp_symb_add");
                   1284:        asir_assert(p2,O_DP,"dp_symb_add");
                   1285:        if ( p1->nv != p2->nv )
                   1286:                error("dp_sumb_add : invalid input");
                   1287:        nv = p1->nv;
                   1288:        s0 = symb_merge(dp_dllist(p1),dp_dllist(p2),nv);
                   1289:        for ( mp0 = 0; s0; s0 = NEXT(s0) ) {
                   1290:                NEXTMP(mp0,mp); mp->dl = (DL)BDY(s0); mp->c = (P)ONE;
                   1291:        }
                   1292:        NEXT(mp) = 0;
                   1293:        MKDP(nv,mp0,r); r->sugar = MAX(p1->sugar,p2->sugar);
                   1294:        *rp = r;
                   1295: }
                   1296:
1.32      noro     1297: void Pdp_mul_trunc(arg,rp)
                   1298: NODE arg;
                   1299: DP *rp;
                   1300: {
                   1301:        DP p1,p2,p;
                   1302:
                   1303:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); p = (DP)ARG2(arg);
                   1304:        asir_assert(p1,O_DP,"dp_mul_trunc");
                   1305:        asir_assert(p2,O_DP,"dp_mul_trunc");
                   1306:        asir_assert(p,O_DP,"dp_mul_trunc");
                   1307:        comm_muld_trunc(CO,p1,p2,BDY(p)->dl,rp);
                   1308: }
                   1309:
                   1310: void Pdp_quo(arg,rp)
                   1311: NODE arg;
                   1312: DP *rp;
                   1313: {
                   1314:        DP p1,p2;
                   1315:
                   1316:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
                   1317:        asir_assert(p1,O_DP,"dp_quo");
                   1318:        asir_assert(p2,O_DP,"dp_quo");
                   1319:        comm_quod(CO,p1,p2,rp);
                   1320: }
                   1321:
1.12      noro     1322: void Pdp_weyl_mul(arg,rp)
                   1323: NODE arg;
                   1324: DP *rp;
                   1325: {
                   1326:        DP p1,p2;
                   1327:
                   1328:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1.32      noro     1329:        asir_assert(p1,O_DP,"dp_weyl_mul"); asir_assert(p2,O_DP,"dp_weyl_mul");
1.12      noro     1330:        do_weyl = 1;
                   1331:        muld(CO,p1,p2,rp);
1.13      noro     1332:        do_weyl = 0;
                   1333: }
                   1334:
                   1335: void Pdp_weyl_mul_mod(arg,rp)
                   1336: NODE arg;
                   1337: DP *rp;
                   1338: {
                   1339:        DP p1,p2;
                   1340:        Q m;
                   1341:
                   1342:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); m = (Q)ARG2(arg);
                   1343:        asir_assert(p1,O_DP,"dp_weyl_mul_mod");
                   1344:        asir_assert(p2,O_DP,"dp_mul_mod");
                   1345:        asir_assert(m,O_N,"dp_mul_mod");
                   1346:        do_weyl = 1;
                   1347:        mulmd(CO,QTOS(m),p1,p2,rp);
1.12      noro     1348:        do_weyl = 0;
                   1349: }
                   1350:
1.1       noro     1351: void Pdp_red(arg,rp)
                   1352: NODE arg;
                   1353: LIST *rp;
                   1354: {
                   1355:        NODE n;
1.4       noro     1356:        DP head,rest,dmy1;
1.1       noro     1357:        P dmy;
                   1358:
1.11      noro     1359:        do_weyl = 0;
1.1       noro     1360:        asir_assert(ARG0(arg),O_DP,"dp_red");
                   1361:        asir_assert(ARG1(arg),O_DP,"dp_red");
                   1362:        asir_assert(ARG2(arg),O_DP,"dp_red");
1.4       noro     1363:        dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1);
1.1       noro     1364:        NEWNODE(n); BDY(n) = (pointer)head;
                   1365:        NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest;
                   1366:        NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
                   1367: }
                   1368:
1.11      noro     1369: void Pdp_weyl_red(arg,rp)
                   1370: NODE arg;
                   1371: LIST *rp;
                   1372: {
                   1373:        NODE n;
                   1374:        DP head,rest,dmy1;
                   1375:        P dmy;
                   1376:
                   1377:        asir_assert(ARG0(arg),O_DP,"dp_weyl_red");
                   1378:        asir_assert(ARG1(arg),O_DP,"dp_weyl_red");
                   1379:        asir_assert(ARG2(arg),O_DP,"dp_weyl_red");
1.12      noro     1380:        do_weyl = 1;
1.11      noro     1381:        dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1);
1.12      noro     1382:        do_weyl = 0;
1.11      noro     1383:        NEWNODE(n); BDY(n) = (pointer)head;
                   1384:        NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest;
                   1385:        NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
                   1386: }
                   1387:
1.1       noro     1388: void Pdp_sp(arg,rp)
                   1389: NODE arg;
                   1390: DP *rp;
                   1391: {
                   1392:        DP p1,p2;
                   1393:
1.11      noro     1394:        do_weyl = 0;
1.1       noro     1395:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
                   1396:        asir_assert(p1,O_DP,"dp_sp"); asir_assert(p2,O_DP,"dp_sp");
                   1397:        dp_sp(p1,p2,rp);
                   1398: }
                   1399:
1.11      noro     1400: void Pdp_weyl_sp(arg,rp)
                   1401: NODE arg;
                   1402: DP *rp;
                   1403: {
                   1404:        DP p1,p2;
                   1405:
                   1406:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
                   1407:        asir_assert(p1,O_DP,"dp_weyl_sp"); asir_assert(p2,O_DP,"dp_sp");
1.12      noro     1408:        do_weyl = 1;
1.11      noro     1409:        dp_sp(p1,p2,rp);
1.12      noro     1410:        do_weyl = 0;
1.11      noro     1411: }
                   1412:
1.1       noro     1413: void Pdp_sp_mod(arg,rp)
                   1414: NODE arg;
                   1415: DP *rp;
                   1416: {
                   1417:        DP p1,p2;
                   1418:        int mod;
                   1419:
1.11      noro     1420:        do_weyl = 0;
1.1       noro     1421:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
                   1422:        asir_assert(p1,O_DP,"dp_sp_mod"); asir_assert(p2,O_DP,"dp_sp_mod");
                   1423:        asir_assert(ARG2(arg),O_N,"dp_sp_mod");
                   1424:        mod = QTOS((Q)ARG2(arg));
                   1425:        dp_sp_mod(p1,p2,mod,rp);
                   1426: }
                   1427:
                   1428: void Pdp_lcm(arg,rp)
                   1429: NODE arg;
                   1430: DP *rp;
                   1431: {
                   1432:        int i,n,td;
                   1433:        DL d1,d2,d;
                   1434:        MP m;
                   1435:        DP p1,p2;
                   1436:
                   1437:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
                   1438:        asir_assert(p1,O_DP,"dp_lcm"); asir_assert(p2,O_DP,"dp_lcm");
                   1439:        n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl;
                   1440:        NEWDL(d,n);
                   1441:        for ( i = 0, td = 0; i < n; i++ ) {
1.24      noro     1442:                d->d[i] = MAX(d1->d[i],d2->d[i]); td += MUL_WEIGHT(d->d[i],i);
1.1       noro     1443:        }
                   1444:        d->td = td;
                   1445:        NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0;
                   1446:        MKDP(n,m,*rp); (*rp)->sugar = td;       /* XXX */
                   1447: }
                   1448:
                   1449: void Pdp_hm(arg,rp)
                   1450: NODE arg;
                   1451: DP *rp;
                   1452: {
                   1453:        DP p;
                   1454:
                   1455:        p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_hm");
                   1456:        dp_hm(p,rp);
                   1457: }
                   1458:
                   1459: void Pdp_ht(arg,rp)
                   1460: NODE arg;
                   1461: DP *rp;
                   1462: {
                   1463:        DP p;
                   1464:        MP m,mr;
                   1465:
                   1466:        p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_ht");
1.52      noro     1467:        dp_ht(p,rp);
1.1       noro     1468: }
                   1469:
                   1470: void Pdp_hc(arg,rp)
                   1471: NODE arg;
                   1472: P *rp;
                   1473: {
                   1474:        asir_assert(ARG0(arg),O_DP,"dp_hc");
                   1475:        if ( !ARG0(arg) )
                   1476:                *rp = 0;
                   1477:        else
                   1478:                *rp = BDY((DP)ARG0(arg))->c;
                   1479: }
                   1480:
                   1481: void Pdp_rest(arg,rp)
                   1482: NODE arg;
                   1483: DP *rp;
                   1484: {
                   1485:        asir_assert(ARG0(arg),O_DP,"dp_rest");
                   1486:        if ( !ARG0(arg) )
                   1487:                *rp = 0;
                   1488:        else
                   1489:                dp_rest((DP)ARG0(arg),rp);
                   1490: }
                   1491:
                   1492: void Pdp_td(arg,rp)
                   1493: NODE arg;
                   1494: Q *rp;
                   1495: {
                   1496:        DP p;
                   1497:
                   1498:        p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_td");
                   1499:        if ( !p )
                   1500:                *rp = 0;
                   1501:        else
                   1502:                STOQ(BDY(p)->dl->td,*rp);
                   1503: }
                   1504:
                   1505: void Pdp_sugar(arg,rp)
                   1506: NODE arg;
                   1507: Q *rp;
                   1508: {
                   1509:        DP p;
                   1510:
                   1511:        p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_sugar");
                   1512:        if ( !p )
                   1513:                *rp = 0;
                   1514:        else
                   1515:                STOQ(p->sugar,*rp);
1.30      ohara    1516: }
                   1517:
1.49      noro     1518: void Pdp_initial_term(arg,rp)
                   1519: NODE arg;
                   1520: Obj *rp;
                   1521: {
                   1522:        struct order_spec *ord;
                   1523:        Num homo;
                   1524:        int modular,is_list;
                   1525:        LIST v,f,l,initiallist;
                   1526:        NODE n;
                   1527:
                   1528:        f = (LIST)ARG0(arg);
                   1529:        if ( f && OID(f) == O_LIST )
                   1530:                is_list = 1;
                   1531:        else {
                   1532:                n = mknode(1,f); MKLIST(l,n); f = l;
                   1533:                is_list = 0;
                   1534:        }
1.54      noro     1535:        if ( current_option ) {
1.53      noro     1536:                parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
1.54      noro     1537:                initd(ord);
                   1538:        } else
1.49      noro     1539:                ord = dp_current_spec;
                   1540:        initiallist = dp_initial_term(f,ord);
                   1541:        if ( !is_list )
                   1542:                *rp = (Obj)BDY(BDY(initiallist));
                   1543:        else
                   1544:                *rp = (Obj)initiallist;
                   1545: }
                   1546:
                   1547: void Pdp_order(arg,rp)
                   1548: NODE arg;
                   1549: Obj *rp;
                   1550: {
                   1551:        struct order_spec *ord;
                   1552:        Num homo;
                   1553:        int modular,is_list;
                   1554:        LIST v,f,l,ordlist;
                   1555:        NODE n;
                   1556:
                   1557:        f = (LIST)ARG0(arg);
                   1558:        if ( f && OID(f) == O_LIST )
                   1559:                is_list = 1;
                   1560:        else {
                   1561:                n = mknode(1,f); MKLIST(l,n); f = l;
                   1562:                is_list = 0;
                   1563:        }
1.54      noro     1564:        if ( current_option ) {
1.53      noro     1565:                parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
1.54      noro     1566:                initd(ord);
                   1567:        } else
1.49      noro     1568:                ord = dp_current_spec;
                   1569:        ordlist = dp_order(f,ord);
                   1570:        if ( !is_list )
                   1571:                *rp = (Obj)BDY(BDY(ordlist));
                   1572:        else
                   1573:                *rp = (Obj)ordlist;
                   1574: }
                   1575:
1.30      ohara    1576: void Pdp_set_sugar(arg,rp)
                   1577: NODE arg;
                   1578: Q *rp;
                   1579: {
                   1580:        DP p;
                   1581:        Q q;
                   1582:        int i;
                   1583:
                   1584:        p = (DP)ARG0(arg);
                   1585:        q = (Q)ARG1(arg);
                   1586:        if ( p && q) {
                   1587:                asir_assert(p,O_DP,"dp_set_sugar");
                   1588:                asir_assert(q,O_N, "dp_set_sugar");
                   1589:                i = QTOS(q);
                   1590:                if (p->sugar < i) {
                   1591:                        p->sugar = i;
                   1592:                }
                   1593:        }
                   1594:        *rp = 0;
1.1       noro     1595: }
                   1596:
                   1597: void Pdp_cri1(arg,rp)
                   1598: NODE arg;
                   1599: Q *rp;
                   1600: {
                   1601:        DP p1,p2;
                   1602:        int *d1,*d2;
                   1603:        int i,n;
                   1604:
                   1605:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
                   1606:        asir_assert(p1,O_DP,"dp_cri1"); asir_assert(p2,O_DP,"dp_cri1");
                   1607:        n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d;
                   1608:        for ( i = 0; i < n; i++ )
                   1609:                if ( d1[i] > d2[i] )
                   1610:                        break;
                   1611:        *rp = i == n ? ONE : 0;
                   1612: }
                   1613:
                   1614: void Pdp_cri2(arg,rp)
                   1615: NODE arg;
                   1616: Q *rp;
                   1617: {
                   1618:        DP p1,p2;
                   1619:        int *d1,*d2;
                   1620:        int i,n;
                   1621:
                   1622:        p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
                   1623:        asir_assert(p1,O_DP,"dp_cri2"); asir_assert(p2,O_DP,"dp_cri2");
                   1624:        n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d;
                   1625:        for ( i = 0; i < n; i++ )
                   1626:                if ( MIN(d1[i],d2[i]) >= 1 )
                   1627:                        break;
                   1628:        *rp = i == n ? ONE : 0;
                   1629: }
                   1630:
                   1631: void Pdp_minp(arg,rp)
                   1632: NODE arg;
                   1633: LIST *rp;
                   1634: {
                   1635:        NODE tn,tn1,d,dd,dd0,p,tp;
                   1636:        LIST l,minp;
                   1637:        DP lcm,tlcm;
                   1638:        int s,ts;
                   1639:
                   1640:        asir_assert(ARG0(arg),O_LIST,"dp_minp");
                   1641:        d = BDY((LIST)ARG0(arg)); minp = (LIST)BDY(d);
                   1642:        p = BDY(minp); p = NEXT(NEXT(p)); lcm = (DP)BDY(p); p = NEXT(p);
                   1643:        if ( !ARG1(arg) ) {
                   1644:                s = QTOS((Q)BDY(p)); p = NEXT(p);
                   1645:                for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) {
                   1646:                        tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp));
                   1647:                        tlcm = (DP)BDY(tp); tp = NEXT(tp);
                   1648:                        ts = QTOS((Q)BDY(tp)); tp = NEXT(tp);
                   1649:                        NEXTNODE(dd0,dd);
                   1650:                        if ( ts < s ) {
                   1651:                                BDY(dd) = (pointer)minp;
                   1652:                                minp = (LIST)BDY(d); lcm = tlcm; s = ts;
                   1653:                        } else if ( ts == s ) {
                   1654:                                if ( compd(CO,lcm,tlcm) > 0 ) {
                   1655:                                        BDY(dd) = (pointer)minp;
                   1656:                                        minp = (LIST)BDY(d); lcm = tlcm; s = ts;
                   1657:                                } else
                   1658:                                        BDY(dd) = BDY(d);
                   1659:                        } else
                   1660:                                BDY(dd) = BDY(d);
                   1661:                }
                   1662:        } else {
                   1663:                for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) {
                   1664:                        tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp));
                   1665:                        tlcm = (DP)BDY(tp);
                   1666:                        NEXTNODE(dd0,dd);
                   1667:                        if ( compd(CO,lcm,tlcm) > 0 ) {
                   1668:                                BDY(dd) = (pointer)minp; minp = (LIST)BDY(d); lcm = tlcm;
                   1669:                        } else
                   1670:                                BDY(dd) = BDY(d);
                   1671:                }
                   1672:        }
                   1673:        if ( dd0 )
                   1674:                NEXT(dd) = 0;
                   1675:        MKLIST(l,dd0); MKNODE(tn,l,0); MKNODE(tn1,minp,tn); MKLIST(*rp,tn1);
                   1676: }
                   1677:
                   1678: void Pdp_criB(arg,rp)
                   1679: NODE arg;
                   1680: LIST *rp;
                   1681: {
                   1682:        NODE d,ij,dd,ddd;
                   1683:        int i,j,s,n;
                   1684:        DP *ps;
                   1685:        DL ts,ti,tj,lij,tdl;
                   1686:
                   1687:        asir_assert(ARG0(arg),O_LIST,"dp_criB"); d = BDY((LIST)ARG0(arg));
                   1688:        asir_assert(ARG1(arg),O_N,"dp_criB"); s = QTOS((Q)ARG1(arg));
                   1689:        asir_assert(ARG2(arg),O_VECT,"dp_criB"); ps = (DP *)BDY((VECT)ARG2(arg));
                   1690:        if ( !d )
                   1691:                *rp = (LIST)ARG0(arg);
                   1692:        else {
                   1693:                ts = BDY(ps[s])->dl;
                   1694:                n = ps[s]->nv;
                   1695:                NEWDL(tdl,n);
                   1696:                for ( dd = 0; d; d = NEXT(d) ) {
                   1697:                        ij = BDY((LIST)BDY(d));
                   1698:                        i = QTOS((Q)BDY(ij)); ij = NEXT(ij);
                   1699:                        j = QTOS((Q)BDY(ij)); ij = NEXT(ij);
                   1700:                        lij = BDY((DP)BDY(ij))->dl;
                   1701:                        ti = BDY(ps[i])->dl; tj = BDY(ps[j])->dl;
                   1702:                        if ( lij->td != lcm_of_DL(n,lij,ts,tdl)->td
                   1703:                                || !dl_equal(n,lij,tdl)
                   1704:                                || (lij->td == lcm_of_DL(n,ti,ts,tdl)->td
                   1705:                                        && dl_equal(n,tdl,lij))
                   1706:                                || (lij->td == lcm_of_DL(n,tj,ts,tdl)->td
                   1707:                                        && dl_equal(n,tdl,lij)) ) {
                   1708:                                MKNODE(ddd,BDY(d),dd);
                   1709:                                dd = ddd;
                   1710:                        }
                   1711:                }
                   1712:                MKLIST(*rp,dd);
                   1713:        }
                   1714: }
                   1715:
                   1716: void Pdp_nelim(arg,rp)
                   1717: NODE arg;
                   1718: Q *rp;
                   1719: {
                   1720:        if ( arg ) {
                   1721:                asir_assert(ARG0(arg),O_N,"dp_nelim");
                   1722:                dp_nelim = QTOS((Q)ARG0(arg));
                   1723:        }
                   1724:        STOQ(dp_nelim,*rp);
                   1725: }
                   1726:
                   1727: void Pdp_mag(arg,rp)
                   1728: NODE arg;
                   1729: Q *rp;
                   1730: {
                   1731:        DP p;
                   1732:        int s;
                   1733:        MP m;
                   1734:
                   1735:        p = (DP)ARG0(arg);
                   1736:        asir_assert(p,O_DP,"dp_mag");
                   1737:        if ( !p )
                   1738:                *rp = 0;
                   1739:        else {
                   1740:                for ( s = 0, m = BDY(p); m; m = NEXT(m) )
                   1741:                        s += p_mag(m->c);
                   1742:                STOQ(s,*rp);
                   1743:        }
                   1744: }
                   1745:
                   1746: extern int kara_mag;
                   1747:
                   1748: void Pdp_set_kara(arg,rp)
                   1749: NODE arg;
                   1750: Q *rp;
                   1751: {
                   1752:        if ( arg ) {
                   1753:                asir_assert(ARG0(arg),O_N,"dp_set_kara");
                   1754:                kara_mag = QTOS((Q)ARG0(arg));
                   1755:        }
                   1756:        STOQ(kara_mag,*rp);
                   1757: }
                   1758:
                   1759: void Pdp_homo(arg,rp)
                   1760: NODE arg;
                   1761: DP *rp;
                   1762: {
                   1763:        asir_assert(ARG0(arg),O_DP,"dp_homo");
                   1764:        dp_homo((DP)ARG0(arg),rp);
                   1765: }
                   1766:
1.8       noro     1767: void Pdp_dehomo(arg,rp)
                   1768: NODE arg;
1.1       noro     1769: DP *rp;
                   1770: {
1.8       noro     1771:        asir_assert(ARG0(arg),O_DP,"dp_dehomo");
                   1772:        dp_dehomo((DP)ARG0(arg),rp);
                   1773: }
                   1774:
                   1775: void Pdp_gr_flags(arg,rp)
                   1776: NODE arg;
                   1777: LIST *rp;
                   1778: {
                   1779:        Obj name,value;
                   1780:        NODE n;
1.1       noro     1781:
1.8       noro     1782:        if ( arg ) {
                   1783:                asir_assert(ARG0(arg),O_LIST,"dp_gr_flags");
                   1784:                n = BDY((LIST)ARG0(arg));
                   1785:                while ( n ) {
                   1786:                        name = (Obj)BDY(n); n = NEXT(n);
                   1787:                        if ( !n )
                   1788:                                break;
                   1789:                        else {
                   1790:                                value = (Obj)BDY(n); n = NEXT(n);
                   1791:                        }
                   1792:                        dp_set_flag(name,value);
1.1       noro     1793:                }
                   1794:        }
1.8       noro     1795:        dp_make_flaglist(rp);
                   1796: }
                   1797:
1.29      noro     1798: extern int DP_Print, DP_PrintShort;
1.8       noro     1799:
                   1800: void Pdp_gr_print(arg,rp)
                   1801: NODE arg;
                   1802: Q *rp;
                   1803: {
                   1804:        Q q;
1.29      noro     1805:        int s;
1.8       noro     1806:
                   1807:        if ( arg ) {
                   1808:                asir_assert(ARG0(arg),O_N,"dp_gr_print");
1.29      noro     1809:                q = (Q)ARG0(arg);
                   1810:                s = QTOS(q);
                   1811:                switch ( s ) {
                   1812:                        case 0:
                   1813:                                DP_Print = 0; DP_PrintShort = 0;
                   1814:                                break;
                   1815:                        case 1:
                   1816:                                DP_Print = 1;
                   1817:                                break;
1.41      noro     1818:                        case 2:
1.29      noro     1819:                                DP_Print = 0; DP_PrintShort = 1;
1.43      noro     1820:                                break;
1.41      noro     1821:                        default:
                   1822:                                DP_Print = s; DP_PrintShort = 0;
1.29      noro     1823:                                break;
                   1824:                }
                   1825:        } else {
                   1826:                if ( DP_Print ) {
                   1827:                        STOQ(1,q);
                   1828:                } else if ( DP_PrintShort ) {
                   1829:                        STOQ(2,q);
                   1830:                } else
                   1831:                        q = 0;
                   1832:        }
1.8       noro     1833:        *rp = q;
1.1       noro     1834: }
                   1835:
1.46      noro     1836: void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo,
                   1837:        int *modular,struct order_spec **ord)
                   1838: {
                   1839:        NODE t,p;
                   1840:        Q m;
                   1841:        char *key;
                   1842:        Obj value,dmy;
                   1843:        int ord_is_set = 0;
                   1844:        int modular_is_set = 0;
                   1845:        int homo_is_set = 0;
1.47      noro     1846:        VL vl,vl0;
1.46      noro     1847:        LIST vars;
1.47      noro     1848:        char xiname[BUFSIZ];
                   1849:        NODE x0,x;
                   1850:        DP d;
                   1851:        P xi;
                   1852:        int nv,i;
1.46      noro     1853:
                   1854:        /* extract vars */
                   1855:        vars = 0;
                   1856:        for ( t = opt; t; t = NEXT(t) ) {
                   1857:                p = BDY((LIST)BDY(t));
                   1858:                key = BDY((STRING)BDY(p));
                   1859:                value = (Obj)BDY(NEXT(p));
                   1860:                if ( !strcmp(key,"v") ) {
                   1861:                        /* variable list */
                   1862:                        vars = (LIST)value;
                   1863:                        break;
                   1864:                }
                   1865:        }
1.48      noro     1866:        if ( vars ) {
                   1867:                *v = vars; pltovl(vars,&vl);
                   1868:        } else {
                   1869:                for ( t = BDY(f); t; t = NEXT(t) )
                   1870:                        if ( BDY(t) && OID((Obj)BDY(t))==O_DP )
                   1871:                                break;
                   1872:                if ( t ) {
                   1873:                        /* f is DP list */
                   1874:                        /* create dummy var list */
                   1875:                        d = (DP)BDY(t);
                   1876:                        nv = NV(d);
                   1877:                        for ( i = 0, vl0 = 0, x0 = 0; i < nv; i++ ) {
                   1878:                                NEXTVL(vl0,vl);
                   1879:                                NEXTNODE(x0,x);
                   1880:                                sprintf(xiname,"x%d",i);
                   1881:                                makevar(xiname,&xi);
                   1882:                                x->body = (pointer)xi;
                   1883:                                vl->v = VR((P)xi);
                   1884:                        }
                   1885:                        if ( vl0 ) {
                   1886:                                NEXT(vl) = 0;
                   1887:                                NEXT(x) = 0;
                   1888:                        }
                   1889:                        MKLIST(vars,x0);
                   1890:                        *v = vars;
                   1891:                        vl = vl0;
                   1892:                } else {
                   1893:                        get_vars((Obj)f,&vl); vltopl(vl,v);
1.47      noro     1894:                }
1.46      noro     1895:        }
                   1896:
                   1897:        for ( t = opt; t; t = NEXT(t) ) {
                   1898:                p = BDY((LIST)BDY(t));
                   1899:                key = BDY((STRING)BDY(p));
                   1900:                value = (Obj)BDY(NEXT(p));
                   1901:                if ( !strcmp(key,"v") ) {
                   1902:                        /* variable list; ignore */
                   1903:                } else if ( !strcmp(key,"order") ) {
                   1904:                        /* order spec */
1.51      noro     1905:                        if ( !vl )
                   1906:                                error("parse_gr_option : variables must be specified");
1.46      noro     1907:                        create_order_spec(vl,value,ord);
                   1908:                        ord_is_set = 1;
                   1909:                } else if ( !strcmp(key,"block") ) {
                   1910:                        create_order_spec(0,value,ord);
1.51      noro     1911:                        ord_is_set = 1;
1.46      noro     1912:                } else if ( !strcmp(key,"matrix") ) {
                   1913:                        create_order_spec(0,value,ord);
1.51      noro     1914:                        ord_is_set = 1;
1.46      noro     1915:                } else if ( !strcmp(key,"sugarweight") ) {
                   1916:                        /* weight */
                   1917:                        Pdp_set_weight(NEXT(p),&dmy);
                   1918:                } else if ( !strcmp(key,"homo") ) {
                   1919:                        *homo = (Num)value;
                   1920:                        homo_is_set = 1;
                   1921:                } else if ( !strcmp(key,"trace") ) {
                   1922:                        m = (Q)value;
                   1923:                        if ( !m )
                   1924:                                *modular = 0;
                   1925:                        else if ( PL(NM(m))>1 || (PL(NM(m)) == 1
                   1926:                                && BD(NM(m))[0] >= 0x80000000) )
                   1927:                                error("parse_gr_option : too large modulus");
                   1928:                        else
                   1929:                                *modular = QTOS(m);
                   1930:                        modular_is_set = 1;
                   1931:                } else
                   1932:                        error("parse_gr_option : not implemented");
                   1933:        }
                   1934:        if ( !ord_is_set ) create_order_spec(0,0,ord);
                   1935:        if ( !modular_is_set ) *modular = 0;
                   1936:        if ( !homo_is_set ) *homo = 0;
                   1937: }
                   1938:
1.8       noro     1939: void Pdp_gr_main(arg,rp)
1.1       noro     1940: NODE arg;
1.8       noro     1941: LIST *rp;
1.1       noro     1942: {
1.8       noro     1943:        LIST f,v;
1.46      noro     1944:        VL vl;
1.8       noro     1945:        Num homo;
                   1946:        Q m;
1.46      noro     1947:        int modular,ac;
                   1948:        struct order_spec *ord;
1.8       noro     1949:
1.11      noro     1950:        do_weyl = 0;
1.8       noro     1951:        asir_assert(ARG0(arg),O_LIST,"dp_gr_main");
1.46      noro     1952:        f = (LIST)ARG0(arg);
1.25      noro     1953:        f = remove_zero_from_list(f);
                   1954:        if ( !BDY(f) ) {
                   1955:                *rp = f; return;
                   1956:        }
1.53      noro     1957:        if ( (ac = argc(arg)) == 5 ) {
1.46      noro     1958:                asir_assert(ARG1(arg),O_LIST,"dp_gr_main");
                   1959:                asir_assert(ARG2(arg),O_N,"dp_gr_main");
                   1960:                asir_assert(ARG3(arg),O_N,"dp_gr_main");
1.49      noro     1961:                v = (LIST)ARG1(arg);
1.46      noro     1962:                homo = (Num)ARG2(arg);
                   1963:                m = (Q)ARG3(arg);
                   1964:                if ( !m )
                   1965:                        modular = 0;
                   1966:                else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) )
                   1967:                        error("dp_gr_main : too large modulus");
                   1968:                else
                   1969:                        modular = QTOS(m);
                   1970:                create_order_spec(0,ARG4(arg),&ord);
1.53      noro     1971:        } else if ( current_option )
                   1972:                parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
1.46      noro     1973:        else if ( ac == 1 )
                   1974:                parse_gr_option(f,0,&v,&homo,&modular,&ord);
1.8       noro     1975:        else
1.46      noro     1976:                error("dp_gr_main : invalid argument");
                   1977:        dp_gr_main(f,v,homo,modular,0,ord,rp);
1.63      noro     1978: }
                   1979:
                   1980: void Pdp_interreduce(arg,rp)
                   1981: NODE arg;
                   1982: LIST *rp;
                   1983: {
                   1984:        LIST f,v;
                   1985:        VL vl;
                   1986:        int ac;
                   1987:        struct order_spec *ord;
                   1988:
                   1989:        do_weyl = 0;
                   1990:        asir_assert(ARG0(arg),O_LIST,"dp_interreduce");
                   1991:        f = (LIST)ARG0(arg);
                   1992:        f = remove_zero_from_list(f);
                   1993:        if ( !BDY(f) ) {
                   1994:                *rp = f; return;
                   1995:        }
                   1996:        if ( (ac = argc(arg)) == 3 ) {
                   1997:                asir_assert(ARG1(arg),O_LIST,"dp_interreduce");
                   1998:                v = (LIST)ARG1(arg);
                   1999:                create_order_spec(0,ARG2(arg),&ord);
                   2000:        }
                   2001:        dp_interreduce(f,v,0,ord,rp);
1.16      noro     2002: }
                   2003:
                   2004: void Pdp_gr_f_main(arg,rp)
                   2005: NODE arg;
                   2006: LIST *rp;
                   2007: {
                   2008:        LIST f,v;
                   2009:        Num homo;
1.26      noro     2010:        int m,field,t;
1.46      noro     2011:        struct order_spec *ord;
1.26      noro     2012:        NODE n;
1.16      noro     2013:
                   2014:        do_weyl = 0;
                   2015:        asir_assert(ARG0(arg),O_LIST,"dp_gr_f_main");
                   2016:        asir_assert(ARG1(arg),O_LIST,"dp_gr_f_main");
                   2017:        asir_assert(ARG2(arg),O_N,"dp_gr_f_main");
                   2018:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25      noro     2019:        f = remove_zero_from_list(f);
                   2020:        if ( !BDY(f) ) {
                   2021:                *rp = f; return;
                   2022:        }
1.16      noro     2023:        homo = (Num)ARG2(arg);
1.27      noro     2024: #if 0
                   2025:        asir_assert(ARG3(arg),O_N,"dp_gr_f_main");
1.26      noro     2026:        m = QTOS((Q)ARG3(arg));
                   2027:        if ( m )
                   2028:                error("dp_gr_f_main : trace lifting is not implemented yet");
1.46      noro     2029:        create_order_spec(0,ARG4(arg),&ord);
1.27      noro     2030: #else
                   2031:        m = 0;
1.46      noro     2032:        create_order_spec(0,ARG3(arg),&ord);
1.27      noro     2033: #endif
1.26      noro     2034:        field = 0;
                   2035:        for ( n = BDY(f); n; n = NEXT(n) ) {
                   2036:                t = get_field_type(BDY(n));
                   2037:                if ( !t )
                   2038:                        continue;
                   2039:                if ( t < 0 )
                   2040:                        error("dp_gr_f_main : incosistent coefficients");
                   2041:                if ( !field )
                   2042:                        field = t;
                   2043:                else if ( t != field )
                   2044:                        error("dp_gr_f_main : incosistent coefficients");
                   2045:        }
1.46      noro     2046:        dp_gr_main(f,v,homo,m?1:0,field,ord,rp);
1.1       noro     2047: }
                   2048:
1.8       noro     2049: void Pdp_f4_main(arg,rp)
                   2050: NODE arg;
                   2051: LIST *rp;
1.1       noro     2052: {
1.8       noro     2053:        LIST f,v;
1.46      noro     2054:        struct order_spec *ord;
1.1       noro     2055:
1.11      noro     2056:        do_weyl = 0;
1.8       noro     2057:        asir_assert(ARG0(arg),O_LIST,"dp_f4_main");
                   2058:        asir_assert(ARG1(arg),O_LIST,"dp_f4_main");
                   2059:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25      noro     2060:        f = remove_zero_from_list(f);
                   2061:        if ( !BDY(f) ) {
                   2062:                *rp = f; return;
                   2063:        }
1.46      noro     2064:        create_order_spec(0,ARG2(arg),&ord);
                   2065:        dp_f4_main(f,v,ord,rp);
1.22      noro     2066: }
                   2067:
                   2068: /* dp_gr_checklist(list of dp) */
                   2069:
                   2070: void Pdp_gr_checklist(arg,rp)
                   2071: NODE arg;
                   2072: LIST *rp;
                   2073: {
                   2074:        VECT g;
                   2075:        LIST dp;
                   2076:        NODE r;
1.23      noro     2077:        int n;
1.22      noro     2078:
                   2079:        do_weyl = 0;
                   2080:        asir_assert(ARG0(arg),O_LIST,"dp_gr_checklist");
1.23      noro     2081:        asir_assert(ARG1(arg),O_N,"dp_gr_checklist");
                   2082:        n = QTOS((Q)ARG1(arg));
                   2083:        gbcheck_list(BDY((LIST)ARG0(arg)),n,&g,&dp);
1.22      noro     2084:        r = mknode(2,g,dp);
                   2085:        MKLIST(*rp,r);
1.1       noro     2086: }
                   2087:
1.8       noro     2088: void Pdp_f4_mod_main(arg,rp)
                   2089: NODE arg;
                   2090: LIST *rp;
1.1       noro     2091: {
1.8       noro     2092:        LIST f,v;
                   2093:        int m;
1.46      noro     2094:        struct order_spec *ord;
1.8       noro     2095:
1.11      noro     2096:        do_weyl = 0;
1.17      noro     2097:        asir_assert(ARG0(arg),O_LIST,"dp_f4_mod_main");
                   2098:        asir_assert(ARG1(arg),O_LIST,"dp_f4_mod_main");
                   2099:        asir_assert(ARG2(arg),O_N,"dp_f4_mod_main");
1.8       noro     2100:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg));
1.25      noro     2101:        f = remove_zero_from_list(f);
                   2102:        if ( !BDY(f) ) {
                   2103:                *rp = f; return;
                   2104:        }
1.20      noro     2105:        if ( !m )
                   2106:                error("dp_f4_mod_main : invalid argument");
1.46      noro     2107:        create_order_spec(0,ARG3(arg),&ord);
                   2108:        dp_f4_mod_main(f,v,m,ord,rp);
1.8       noro     2109: }
1.1       noro     2110:
1.8       noro     2111: void Pdp_gr_mod_main(arg,rp)
                   2112: NODE arg;
                   2113: LIST *rp;
                   2114: {
                   2115:        LIST f,v;
                   2116:        Num homo;
                   2117:        int m;
1.46      noro     2118:        struct order_spec *ord;
1.8       noro     2119:
1.11      noro     2120:        do_weyl = 0;
1.8       noro     2121:        asir_assert(ARG0(arg),O_LIST,"dp_gr_mod_main");
                   2122:        asir_assert(ARG1(arg),O_LIST,"dp_gr_mod_main");
                   2123:        asir_assert(ARG2(arg),O_N,"dp_gr_mod_main");
                   2124:        asir_assert(ARG3(arg),O_N,"dp_gr_mod_main");
1.11      noro     2125:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25      noro     2126:        f = remove_zero_from_list(f);
                   2127:        if ( !BDY(f) ) {
                   2128:                *rp = f; return;
                   2129:        }
1.11      noro     2130:        homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg));
1.20      noro     2131:        if ( !m )
                   2132:                error("dp_gr_mod_main : invalid argument");
1.46      noro     2133:        create_order_spec(0,ARG4(arg),&ord);
                   2134:        dp_gr_mod_main(f,v,homo,m,ord,rp);
1.33      noro     2135: }
                   2136:
1.40      noro     2137: void Pnd_f4(arg,rp)
                   2138: NODE arg;
                   2139: LIST *rp;
                   2140: {
                   2141:        LIST f,v;
1.87      noro     2142:        int m,homo,retdp;
                   2143:        Obj val;
1.46      noro     2144:        struct order_spec *ord;
1.40      noro     2145:
                   2146:        do_weyl = 0;
1.76      noro     2147:        asir_assert(ARG0(arg),O_LIST,"nd_f4");
                   2148:        asir_assert(ARG1(arg),O_LIST,"nd_f4");
                   2149:        asir_assert(ARG2(arg),O_N,"nd_f4");
1.40      noro     2150:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                   2151:        f = remove_zero_from_list(f);
                   2152:        if ( !BDY(f) ) {
                   2153:                *rp = f; return;
                   2154:        }
                   2155:        m = QTOS((Q)ARG2(arg));
1.46      noro     2156:        create_order_spec(0,ARG3(arg),&ord);
1.87      noro     2157:        homo = retdp = 0;
                   2158:        if ( get_opt("homo",&val) && val ) homo = 1;
                   2159:        if ( get_opt("dp",&val) && val ) retdp = 1;
                   2160:        nd_gr(f,v,m,homo,retdp,1,ord,rp);
1.40      noro     2161: }
                   2162:
1.33      noro     2163: void Pnd_gr(arg,rp)
                   2164: NODE arg;
                   2165: LIST *rp;
                   2166: {
                   2167:        LIST f,v;
1.87      noro     2168:        int m,homo,retdp;
                   2169:        Obj val;
1.46      noro     2170:        struct order_spec *ord;
1.33      noro     2171:
                   2172:        do_weyl = 0;
                   2173:        asir_assert(ARG0(arg),O_LIST,"nd_gr");
                   2174:        asir_assert(ARG1(arg),O_LIST,"nd_gr");
1.36      noro     2175:        asir_assert(ARG2(arg),O_N,"nd_gr");
1.33      noro     2176:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                   2177:        f = remove_zero_from_list(f);
                   2178:        if ( !BDY(f) ) {
                   2179:                *rp = f; return;
                   2180:        }
                   2181:        m = QTOS((Q)ARG2(arg));
1.46      noro     2182:        create_order_spec(0,ARG3(arg),&ord);
1.87      noro     2183:        homo = retdp = 0;
                   2184:        if ( get_opt("homo",&val) && val ) homo = 1;
                   2185:        if ( get_opt("dp",&val) && val ) retdp = 1;
                   2186:        nd_gr(f,v,m,homo,retdp,0,ord,rp);
1.58      noro     2187: }
                   2188:
                   2189: void Pnd_gr_postproc(arg,rp)
                   2190: NODE arg;
                   2191: LIST *rp;
                   2192: {
                   2193:        LIST f,v;
                   2194:        int m,do_check;
                   2195:        struct order_spec *ord;
                   2196:
                   2197:        do_weyl = 0;
                   2198:        asir_assert(ARG0(arg),O_LIST,"nd_gr");
                   2199:        asir_assert(ARG1(arg),O_LIST,"nd_gr");
                   2200:        asir_assert(ARG2(arg),O_N,"nd_gr");
                   2201:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                   2202:        f = remove_zero_from_list(f);
                   2203:        if ( !BDY(f) ) {
                   2204:                *rp = f; return;
                   2205:        }
                   2206:        m = QTOS((Q)ARG2(arg));
                   2207:        create_order_spec(0,ARG3(arg),&ord);
                   2208:        do_check = ARG4(arg) ? 1 : 0;
                   2209:        nd_gr_postproc(f,v,m,ord,do_check,rp);
1.36      noro     2210: }
                   2211:
1.86      noro     2212: void Pnd_gr_recompute_trace(arg,rp)
                   2213: NODE arg;
                   2214: LIST *rp;
                   2215: {
                   2216:        LIST f,v,tlist;
                   2217:        int m;
                   2218:        struct order_spec *ord;
                   2219:
                   2220:        do_weyl = 0;
                   2221:        asir_assert(ARG0(arg),O_LIST,"nd_gr_recompute_trace");
                   2222:        asir_assert(ARG1(arg),O_LIST,"nd_gr_recompute_trace");
                   2223:        asir_assert(ARG2(arg),O_N,"nd_gr_recompute_trace");
                   2224:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                   2225:        m = QTOS((Q)ARG2(arg));
                   2226:        create_order_spec(0,ARG3(arg),&ord);
                   2227:        tlist = (LIST)ARG4(arg);
                   2228:        nd_gr_recompute_trace(f,v,m,ord,tlist,rp);
                   2229: }
1.89      noro     2230:
1.90      noro     2231: Obj nd_btog_one(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,int pos);
                   2232: Obj nd_btog(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist);
                   2233:
1.89      noro     2234: void Pnd_btog(arg,rp)
                   2235: NODE arg;
1.90      noro     2236: Obj *rp;
1.89      noro     2237: {
                   2238:        LIST f,v,tlist;
1.90      noro     2239:        int m,ac,pos;
1.89      noro     2240:        struct order_spec *ord;
                   2241:
                   2242:        do_weyl = 0;
                   2243:        asir_assert(ARG0(arg),O_LIST,"nd_btog");
                   2244:        asir_assert(ARG1(arg),O_LIST,"nd_btog");
                   2245:        asir_assert(ARG2(arg),O_N,"nd_btog");
                   2246:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                   2247:        m = QTOS((Q)ARG2(arg));
                   2248:        create_order_spec(0,ARG3(arg),&ord);
                   2249:        tlist = (LIST)ARG4(arg);
1.90      noro     2250:        if ( (ac = argc(arg)) == 6 ) {
                   2251:                asir_assert(ARG5(arg),O_N,"nd_btog");
                   2252:                pos = QTOS((Q)ARG5(arg));
                   2253:                *rp = nd_btog_one(f,v,m,ord,tlist,pos);
                   2254:        } else if ( ac == 5 )
                   2255:                *rp = nd_btog(f,v,m,ord,tlist);
                   2256:        else
                   2257:                error("nd_btog : argument mismatch");
1.89      noro     2258: }
1.86      noro     2259:
1.75      noro     2260: void Pnd_weyl_gr_postproc(arg,rp)
                   2261: NODE arg;
                   2262: LIST *rp;
                   2263: {
                   2264:        LIST f,v;
                   2265:        int m,do_check;
                   2266:        struct order_spec *ord;
                   2267:
                   2268:        do_weyl = 1;
                   2269:        asir_assert(ARG0(arg),O_LIST,"nd_gr");
                   2270:        asir_assert(ARG1(arg),O_LIST,"nd_gr");
                   2271:        asir_assert(ARG2(arg),O_N,"nd_gr");
                   2272:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                   2273:        f = remove_zero_from_list(f);
                   2274:        if ( !BDY(f) ) {
1.80      noro     2275:                *rp = f; do_weyl = 0; return;
1.75      noro     2276:        }
                   2277:        m = QTOS((Q)ARG2(arg));
                   2278:        create_order_spec(0,ARG3(arg),&ord);
                   2279:        do_check = ARG4(arg) ? 1 : 0;
                   2280:        nd_gr_postproc(f,v,m,ord,do_check,rp);
1.80      noro     2281:        do_weyl = 0;
1.75      noro     2282: }
                   2283:
1.36      noro     2284: void Pnd_gr_trace(arg,rp)
                   2285: NODE arg;
                   2286: LIST *rp;
                   2287: {
                   2288:        LIST f,v;
                   2289:        int m,homo;
1.46      noro     2290:        struct order_spec *ord;
1.36      noro     2291:
                   2292:        do_weyl = 0;
                   2293:        asir_assert(ARG0(arg),O_LIST,"nd_gr_trace");
                   2294:        asir_assert(ARG1(arg),O_LIST,"nd_gr_trace");
                   2295:        asir_assert(ARG2(arg),O_N,"nd_gr_trace");
                   2296:        asir_assert(ARG3(arg),O_N,"nd_gr_trace");
                   2297:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                   2298:        f = remove_zero_from_list(f);
                   2299:        if ( !BDY(f) ) {
                   2300:                *rp = f; return;
                   2301:        }
                   2302:        homo = QTOS((Q)ARG2(arg));
                   2303:        m = QTOS((Q)ARG3(arg));
1.46      noro     2304:        create_order_spec(0,ARG4(arg),&ord);
1.62      noro     2305:        nd_gr_trace(f,v,m,homo,0,ord,rp);
                   2306: }
                   2307:
                   2308: void Pnd_f4_trace(arg,rp)
                   2309: NODE arg;
                   2310: LIST *rp;
                   2311: {
                   2312:        LIST f,v;
                   2313:        int m,homo;
                   2314:        struct order_spec *ord;
                   2315:
                   2316:        do_weyl = 0;
                   2317:        asir_assert(ARG0(arg),O_LIST,"nd_gr_trace");
                   2318:        asir_assert(ARG1(arg),O_LIST,"nd_gr_trace");
                   2319:        asir_assert(ARG2(arg),O_N,"nd_gr_trace");
                   2320:        asir_assert(ARG3(arg),O_N,"nd_gr_trace");
                   2321:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                   2322:        f = remove_zero_from_list(f);
                   2323:        if ( !BDY(f) ) {
                   2324:                *rp = f; return;
                   2325:        }
                   2326:        homo = QTOS((Q)ARG2(arg));
                   2327:        m = QTOS((Q)ARG3(arg));
                   2328:        create_order_spec(0,ARG4(arg),&ord);
                   2329:        nd_gr_trace(f,v,m,homo,1,ord,rp);
1.11      noro     2330: }
                   2331:
1.38      noro     2332: void Pnd_weyl_gr(arg,rp)
                   2333: NODE arg;
                   2334: LIST *rp;
                   2335: {
                   2336:        LIST f,v;
1.87      noro     2337:        int m,homo,retdp;
                   2338:        Obj val;
1.46      noro     2339:        struct order_spec *ord;
1.38      noro     2340:
                   2341:        do_weyl = 1;
                   2342:        asir_assert(ARG0(arg),O_LIST,"nd_weyl_gr");
                   2343:        asir_assert(ARG1(arg),O_LIST,"nd_weyl_gr");
                   2344:        asir_assert(ARG2(arg),O_N,"nd_weyl_gr");
                   2345:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                   2346:        f = remove_zero_from_list(f);
                   2347:        if ( !BDY(f) ) {
1.80      noro     2348:                *rp = f; do_weyl = 0; return;
1.38      noro     2349:        }
                   2350:        m = QTOS((Q)ARG2(arg));
1.46      noro     2351:        create_order_spec(0,ARG3(arg),&ord);
1.87      noro     2352:        homo = retdp = 0;
                   2353:        if ( get_opt("homo",&val) && val ) homo = 1;
                   2354:        if ( get_opt("dp",&val) && val ) retdp = 1;
                   2355:        nd_gr(f,v,m,homo,retdp,0,ord,rp);
1.80      noro     2356:        do_weyl = 0;
1.38      noro     2357: }
                   2358:
                   2359: void Pnd_weyl_gr_trace(arg,rp)
                   2360: NODE arg;
                   2361: LIST *rp;
                   2362: {
                   2363:        LIST f,v;
                   2364:        int m,homo;
1.46      noro     2365:        struct order_spec *ord;
1.38      noro     2366:
                   2367:        do_weyl = 1;
                   2368:        asir_assert(ARG0(arg),O_LIST,"nd_weyl_gr_trace");
                   2369:        asir_assert(ARG1(arg),O_LIST,"nd_weyl_gr_trace");
                   2370:        asir_assert(ARG2(arg),O_N,"nd_weyl_gr_trace");
                   2371:        asir_assert(ARG3(arg),O_N,"nd_weyl_gr_trace");
                   2372:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                   2373:        f = remove_zero_from_list(f);
                   2374:        if ( !BDY(f) ) {
1.80      noro     2375:                *rp = f; do_weyl = 0; return;
1.38      noro     2376:        }
                   2377:        homo = QTOS((Q)ARG2(arg));
                   2378:        m = QTOS((Q)ARG3(arg));
1.46      noro     2379:        create_order_spec(0,ARG4(arg),&ord);
1.65      noro     2380:        nd_gr_trace(f,v,m,homo,0,ord,rp);
1.80      noro     2381:        do_weyl = 0;
1.38      noro     2382: }
1.39      noro     2383:
1.83      noro     2384: void Pnd_nf(NODE arg,Obj *rp)
1.39      noro     2385: {
1.83      noro     2386:        Obj f;
1.39      noro     2387:        LIST g,v;
1.46      noro     2388:        struct order_spec *ord;
1.39      noro     2389:
                   2390:        do_weyl = 0;
                   2391:        asir_assert(ARG1(arg),O_LIST,"nd_nf");
                   2392:        asir_assert(ARG2(arg),O_LIST,"nd_nf");
                   2393:        asir_assert(ARG4(arg),O_N,"nd_nf");
1.83      noro     2394:        f = (Obj)ARG0(arg);
                   2395:        g = (LIST)ARG1(arg); g = remove_zero_from_list(g);
                   2396:        if ( !BDY(g) ) {
                   2397:                *rp = f; return;
                   2398:        }
                   2399:        v = (LIST)ARG2(arg);
                   2400:        create_order_spec(0,ARG3(arg),&ord);
                   2401:        nd_nf_p(f,g,v,QTOS((Q)ARG4(arg)),ord,rp);
                   2402: }
                   2403:
                   2404: void Pnd_weyl_nf(NODE arg,Obj *rp)
                   2405: {
                   2406:        Obj f;
                   2407:        LIST g,v;
                   2408:        struct order_spec *ord;
                   2409:
                   2410:        do_weyl = 1;
                   2411:        asir_assert(ARG1(arg),O_LIST,"nd_weyl_nf");
                   2412:        asir_assert(ARG2(arg),O_LIST,"nd_weyl_nf");
                   2413:        asir_assert(ARG4(arg),O_N,"nd_weyl_nf");
                   2414:        f = (Obj)ARG0(arg);
1.39      noro     2415:        g = (LIST)ARG1(arg); g = remove_zero_from_list(g);
                   2416:        if ( !BDY(g) ) {
                   2417:                *rp = f; return;
                   2418:        }
                   2419:        v = (LIST)ARG2(arg);
1.46      noro     2420:        create_order_spec(0,ARG3(arg),&ord);
                   2421:        nd_nf_p(f,g,v,QTOS((Q)ARG4(arg)),ord,rp);
1.39      noro     2422: }
                   2423:
1.11      noro     2424: /* for Weyl algebra */
                   2425:
                   2426: void Pdp_weyl_gr_main(arg,rp)
                   2427: NODE arg;
                   2428: LIST *rp;
                   2429: {
                   2430:        LIST f,v;
                   2431:        Num homo;
                   2432:        Q m;
1.49      noro     2433:        int modular,ac;
1.46      noro     2434:        struct order_spec *ord;
1.11      noro     2435:
1.49      noro     2436:
1.11      noro     2437:        asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main");
1.49      noro     2438:        f = (LIST)ARG0(arg);
1.25      noro     2439:        f = remove_zero_from_list(f);
                   2440:        if ( !BDY(f) ) {
                   2441:                *rp = f; return;
                   2442:        }
1.53      noro     2443:        if ( (ac = argc(arg)) == 5 ) {
1.49      noro     2444:                asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main");
                   2445:                asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main");
                   2446:                asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main");
                   2447:                v = (LIST)ARG1(arg);
                   2448:                homo = (Num)ARG2(arg);
                   2449:                m = (Q)ARG3(arg);
                   2450:                if ( !m )
                   2451:                        modular = 0;
                   2452:                else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) )
                   2453:                        error("dp_weyl_gr_main : too large modulus");
                   2454:                else
                   2455:                        modular = QTOS(m);
                   2456:                create_order_spec(0,ARG4(arg),&ord);
1.53      noro     2457:        } else if ( current_option )
                   2458:                parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
1.49      noro     2459:        else if ( ac == 1 )
                   2460:                parse_gr_option(f,0,&v,&homo,&modular,&ord);
1.11      noro     2461:        else
1.49      noro     2462:                error("dp_weyl_gr_main : invalid argument");
1.12      noro     2463:        do_weyl = 1;
1.46      noro     2464:        dp_gr_main(f,v,homo,modular,0,ord,rp);
1.16      noro     2465:        do_weyl = 0;
                   2466: }
                   2467:
                   2468: void Pdp_weyl_gr_f_main(arg,rp)
                   2469: NODE arg;
                   2470: LIST *rp;
                   2471: {
                   2472:        LIST f,v;
                   2473:        Num homo;
1.46      noro     2474:        struct order_spec *ord;
1.16      noro     2475:
                   2476:        asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main");
                   2477:        asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main");
                   2478:        asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main");
                   2479:        asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main");
                   2480:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25      noro     2481:        f = remove_zero_from_list(f);
                   2482:        if ( !BDY(f) ) {
                   2483:                *rp = f; return;
                   2484:        }
1.16      noro     2485:        homo = (Num)ARG2(arg);
1.46      noro     2486:        create_order_spec(0,ARG3(arg),&ord);
1.16      noro     2487:        do_weyl = 1;
1.46      noro     2488:        dp_gr_main(f,v,homo,0,1,ord,rp);
1.12      noro     2489:        do_weyl = 0;
1.11      noro     2490: }
                   2491:
                   2492: void Pdp_weyl_f4_main(arg,rp)
                   2493: NODE arg;
                   2494: LIST *rp;
                   2495: {
                   2496:        LIST f,v;
1.46      noro     2497:        struct order_spec *ord;
1.11      noro     2498:
                   2499:        asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main");
                   2500:        asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main");
                   2501:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25      noro     2502:        f = remove_zero_from_list(f);
                   2503:        if ( !BDY(f) ) {
                   2504:                *rp = f; return;
                   2505:        }
1.46      noro     2506:        create_order_spec(0,ARG2(arg),&ord);
1.12      noro     2507:        do_weyl = 1;
1.46      noro     2508:        dp_f4_main(f,v,ord,rp);
1.12      noro     2509:        do_weyl = 0;
1.11      noro     2510: }
                   2511:
                   2512: void Pdp_weyl_f4_mod_main(arg,rp)
                   2513: NODE arg;
                   2514: LIST *rp;
                   2515: {
                   2516:        LIST f,v;
                   2517:        int m;
1.46      noro     2518:        struct order_spec *ord;
1.11      noro     2519:
                   2520:        asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main");
                   2521:        asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main");
                   2522:        asir_assert(ARG2(arg),O_N,"dp_f4_main");
                   2523:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg));
1.25      noro     2524:        f = remove_zero_from_list(f);
                   2525:        if ( !BDY(f) ) {
                   2526:                *rp = f; return;
                   2527:        }
1.20      noro     2528:        if ( !m )
                   2529:                error("dp_weyl_f4_mod_main : invalid argument");
1.46      noro     2530:        create_order_spec(0,ARG3(arg),&ord);
1.12      noro     2531:        do_weyl = 1;
1.46      noro     2532:        dp_f4_mod_main(f,v,m,ord,rp);
1.12      noro     2533:        do_weyl = 0;
1.11      noro     2534: }
                   2535:
                   2536: void Pdp_weyl_gr_mod_main(arg,rp)
                   2537: NODE arg;
                   2538: LIST *rp;
                   2539: {
                   2540:        LIST f,v;
                   2541:        Num homo;
                   2542:        int m;
1.46      noro     2543:        struct order_spec *ord;
1.11      noro     2544:
                   2545:        asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_mod_main");
                   2546:        asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_mod_main");
                   2547:        asir_assert(ARG2(arg),O_N,"dp_weyl_gr_mod_main");
                   2548:        asir_assert(ARG3(arg),O_N,"dp_weyl_gr_mod_main");
1.8       noro     2549:        f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25      noro     2550:        f = remove_zero_from_list(f);
                   2551:        if ( !BDY(f) ) {
                   2552:                *rp = f; return;
                   2553:        }
1.8       noro     2554:        homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg));
1.20      noro     2555:        if ( !m )
                   2556:                error("dp_weyl_gr_mod_main : invalid argument");
1.46      noro     2557:        create_order_spec(0,ARG4(arg),&ord);
1.12      noro     2558:        do_weyl = 1;
1.46      noro     2559:        dp_gr_mod_main(f,v,homo,m,ord,rp);
1.12      noro     2560:        do_weyl = 0;
1.1       noro     2561: }
1.8       noro     2562:
1.57      noro     2563: VECT current_dl_weight_vector_obj;
1.24      noro     2564: int *current_dl_weight_vector;
                   2565:
                   2566: void Pdp_set_weight(arg,rp)
                   2567: NODE arg;
                   2568: VECT *rp;
                   2569: {
                   2570:        VECT v;
                   2571:        int i,n;
1.45      noro     2572:        NODE node;
1.24      noro     2573:
                   2574:        if ( !arg )
                   2575:                *rp = current_dl_weight_vector_obj;
                   2576:        else if ( !ARG0(arg) ) {
                   2577:                current_dl_weight_vector_obj = 0;
                   2578:                current_dl_weight_vector = 0;
                   2579:                *rp = 0;
                   2580:        } else {
1.45      noro     2581:                if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST )
                   2582:                        error("dp_set_weight : invalid argument");
                   2583:                if ( OID(ARG0(arg)) == O_VECT )
                   2584:                        v = (VECT)ARG0(arg);
                   2585:                else {
                   2586:                        node = (NODE)BDY((LIST)ARG0(arg));
                   2587:                        n = length(node);
                   2588:                        MKVECT(v,n);
                   2589:                        for ( i = 0; i < n; i++, node = NEXT(node) )
                   2590:                                BDY(v)[i] = BDY(node);
                   2591:                }
1.24      noro     2592:                current_dl_weight_vector_obj = v;
                   2593:                n = v->len;
                   2594:                current_dl_weight_vector = (int *)CALLOC(n,sizeof(int));
                   2595:                for ( i = 0; i < n; i++ )
                   2596:                        current_dl_weight_vector[i] = QTOS((Q)v->body[i]);
                   2597:                *rp = v;
                   2598:        }
                   2599: }
                   2600:
1.77      noro     2601: VECT current_module_weight_vector_obj;
                   2602: int *current_module_weight_vector;
                   2603:
                   2604: void Pdp_set_module_weight(arg,rp)
                   2605: NODE arg;
                   2606: VECT *rp;
                   2607: {
                   2608:        VECT v;
                   2609:        int i,n;
                   2610:        NODE node;
                   2611:
                   2612:        if ( !arg )
                   2613:                *rp = current_module_weight_vector_obj;
                   2614:        else if ( !ARG0(arg) ) {
                   2615:                current_module_weight_vector_obj = 0;
                   2616:                current_module_weight_vector = 0;
                   2617:                *rp = 0;
                   2618:        } else {
                   2619:                if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST )
                   2620:                        error("dp_module_set_weight : invalid argument");
                   2621:                if ( OID(ARG0(arg)) == O_VECT )
                   2622:                        v = (VECT)ARG0(arg);
                   2623:                else {
                   2624:                        node = (NODE)BDY((LIST)ARG0(arg));
                   2625:                        n = length(node);
                   2626:                        MKVECT(v,n);
                   2627:                        for ( i = 0; i < n; i++, node = NEXT(node) )
                   2628:                                BDY(v)[i] = BDY(node);
                   2629:                }
                   2630:                current_module_weight_vector_obj = v;
                   2631:                n = v->len;
                   2632:                current_module_weight_vector = (int *)CALLOC(n,sizeof(int));
                   2633:                for ( i = 0; i < n; i++ )
                   2634:                        current_module_weight_vector[i] = QTOS((Q)v->body[i]);
                   2635:                *rp = v;
                   2636:        }
                   2637: }
                   2638:
1.92    ! noro     2639: Obj current_top_weight;
        !          2640: extern Obj nd_top_weight;
1.71      noro     2641:
1.92    ! noro     2642: void Pdp_set_top_weight(NODE arg,Obj *rp)
1.71      noro     2643: {
                   2644:        VECT v;
1.92    ! noro     2645:        MAT m;
        !          2646:        Obj obj;
        !          2647:        int i,j,n,id,row,col;
        !          2648:        Q *mi;
1.71      noro     2649:        NODE node;
                   2650:
                   2651:        if ( !arg )
1.92    ! noro     2652:                *rp = current_top_weight;
1.71      noro     2653:        else if ( !ARG0(arg) ) {
1.92    ! noro     2654:                nd_top_weight = 0;
        !          2655:                current_top_weight = 0;
1.71      noro     2656:                *rp = 0;
                   2657:        } else {
1.92    ! noro     2658:                id = OID(ARG0(arg));
        !          2659:                if ( id != O_VECT && id != O_MAT && id != O_LIST )
1.71      noro     2660:                        error("dp_set_top_weight : invalid argument");
1.92    ! noro     2661:                if ( id == O_LIST ) {
1.71      noro     2662:                        node = (NODE)BDY((LIST)ARG0(arg));
                   2663:                        n = length(node);
                   2664:                        MKVECT(v,n);
                   2665:                        for ( i = 0; i < n; i++, node = NEXT(node) )
                   2666:                                BDY(v)[i] = BDY(node);
1.92    ! noro     2667:                    obj = v;
        !          2668:                } else
        !          2669:                    obj = ARG0(arg);
        !          2670:                if ( OID(obj) == O_VECT ) {
        !          2671:                        v = (VECT)obj;
        !          2672:                    for ( i = 0; i < v->len; i++ )
        !          2673:                            if ( !INT(BDY(v)[i]) || (BDY(v)[i] && SGN((Q)BDY(v)[i]) < 0) )
        !          2674:                                    error("dp_set_top_weight : each element must be a non-negative integer");
        !          2675:                } else {
        !          2676:                        m = (MAT)obj; row = m->row; col = m->col;
        !          2677:                    for ( i = 0; i < row; i++ )
        !          2678:                                for ( j = 0, mi = (Q *)BDY(m)[i]; j < col; j++ )
        !          2679:                                if ( !INT(mi[j]) || (mi[j] && SGN((Q)mi[j]) < 0) )
        !          2680:                                        error("dp_set_top_weight : each element must be a non-negative integer");
        !          2681:                }
        !          2682:         current_top_weight = obj;
        !          2683:                nd_top_weight = obj;
        !          2684:                *rp = current_top_weight;
1.71      noro     2685:        }
                   2686: }
                   2687:
1.72      noro     2688: LIST get_denomlist();
                   2689:
                   2690: void Pdp_get_denomlist(LIST *rp)
                   2691: {
                   2692:        *rp = get_denomlist();
                   2693: }
                   2694:
1.24      noro     2695: static VECT current_weyl_weight_vector_obj;
                   2696: int *current_weyl_weight_vector;
1.15      noro     2697:
                   2698: void Pdp_weyl_set_weight(arg,rp)
                   2699: NODE arg;
                   2700: VECT *rp;
                   2701: {
                   2702:        VECT v;
1.85      noro     2703:        NODE node;
1.15      noro     2704:        int i,n;
                   2705:
                   2706:        if ( !arg )
1.24      noro     2707:                *rp = current_weyl_weight_vector_obj;
1.78      noro     2708:        else if ( !ARG0(arg) ) {
                   2709:                current_weyl_weight_vector_obj = 0;
                   2710:                current_weyl_weight_vector = 0;
                   2711:                *rp = 0;
                   2712:        } else {
1.85      noro     2713:                if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST )
                   2714:                        error("dp_weyl_set_weight : invalid argument");
                   2715:                if ( OID(ARG0(arg)) == O_VECT )
                   2716:                        v = (VECT)ARG0(arg);
                   2717:                else {
                   2718:                        node = (NODE)BDY((LIST)ARG0(arg));
                   2719:                        n = length(node);
                   2720:                        MKVECT(v,n);
                   2721:                        for ( i = 0; i < n; i++, node = NEXT(node) )
                   2722:                                BDY(v)[i] = BDY(node);
                   2723:                }
1.24      noro     2724:                current_weyl_weight_vector_obj = v;
1.15      noro     2725:                n = v->len;
1.24      noro     2726:                current_weyl_weight_vector = (int *)CALLOC(n,sizeof(int));
1.15      noro     2727:                for ( i = 0; i < n; i++ )
1.24      noro     2728:                        current_weyl_weight_vector[i] = QTOS((Q)v->body[i]);
1.15      noro     2729:                *rp = v;
                   2730:        }
1.25      noro     2731: }
                   2732:
1.82      noro     2733: NODE mono_raddec(NODE ideal);
                   2734:
                   2735: void Pdp_mono_raddec(NODE arg,LIST *rp)
                   2736: {
                   2737:        NODE ideal,rd,t,t1,r,r1,u;
                   2738:        VL vl0,vl;
                   2739:        int nv,i,bpi;
                   2740:        int *s;
                   2741:        DP dp;
                   2742:        P *v;
                   2743:        LIST l;
                   2744:
                   2745:        ideal = BDY((LIST)ARG0(arg));
                   2746:        if ( !ideal ) *rp = (LIST)ARG0(arg);
                   2747:        else {
                   2748:                t = BDY((LIST)ARG1(arg));
                   2749:                nv = length(t);
                   2750:                v = (P)MALLOC(nv*sizeof(P));
                   2751:                for ( vl0 = 0, i = 0; t; t = NEXT(t), i++ ) {
                   2752:                        NEXTVL(vl0,vl); VR(vl) = VR((P)BDY(t));
                   2753:                        MKV(VR(vl),v[i]);
                   2754:                }
                   2755:                if ( vl0 ) NEXT(vl) = 0;
                   2756:                for ( t = 0, r = ideal; r; r = NEXT(r) ) {
                   2757:                        ptod(CO,vl0,BDY(r),&dp); MKNODE(t1,dp,t); t = t1;
                   2758:                }
                   2759:                rd = mono_raddec(t);
                   2760:                r = 0;
                   2761:                bpi = (sizeof(int)/sizeof(char))*8;
                   2762:                for ( u = rd; u; u = NEXT(u) ) {
                   2763:                        s = (int *)BDY(u);
                   2764:                        for ( i = nv-1, t = 0; i >= 0; i-- )
                   2765:                                if ( s[i/bpi]&(1<<(i%bpi)) ) {
                   2766:                                        MKNODE(t1,v[i],t); t = t1;
                   2767:                                }
                   2768:                        MKLIST(l,t); MKNODE(r1,l,r); r = r1;
                   2769:                }
                   2770:                MKLIST(*rp,r);
                   2771:        }
                   2772: }
                   2773:
1.84      noro     2774: void Pdp_mono_reduce(NODE arg,LIST *rp)
                   2775: {
                   2776:        NODE t,t0,t1,r0,r;
                   2777:        int i,n;
                   2778:        DP m;
                   2779:        DP *a;
                   2780:
                   2781:        t0 = BDY((LIST)ARG0(arg));
                   2782:        t1 = BDY((LIST)ARG1(arg));
                   2783:        n = length(t0);
                   2784:        a = (DP *)MALLOC(n*sizeof(DP));
                   2785:        for ( i = 0; i < n; i++, t0 = NEXT(t0) ) a[i] = (DP)BDY(t0);
                   2786:        for ( t = t1; t; t = NEXT(t) ) {
                   2787:                m = (DP)BDY(t);
                   2788:                for ( i = 0; i < n; i++ )
                   2789:                        if ( a[i] && dp_redble(a[i],m) ) a[i] = 0;
                   2790:        }
                   2791:        for ( i = n-1, r0 = 0; i >= 0; i-- )
                   2792:                if ( a[i] ) { NEXTNODE(r0,r); BDY(r) = a[i]; }
                   2793:        if ( r0 ) NEXT(r) = 0;
                   2794:        MKLIST(*rp,r0);
                   2795: }
                   2796:
1.25      noro     2797: LIST remove_zero_from_list(LIST l)
                   2798: {
                   2799:        NODE n,r0,r;
                   2800:        LIST rl;
                   2801:
                   2802:        asir_assert(l,O_LIST,"remove_zero_from_list");
                   2803:        n = BDY(l);
                   2804:        for ( r0 = 0; n; n = NEXT(n) )
                   2805:                if ( BDY(n) ) {
                   2806:                        NEXTNODE(r0,r);
                   2807:                        BDY(r) = BDY(n);
                   2808:                }
                   2809:        if ( r0 )
                   2810:                NEXT(r) = 0;
                   2811:        MKLIST(rl,r0);
                   2812:        return rl;
1.26      noro     2813: }
                   2814:
                   2815: int get_field_type(P p)
                   2816: {
                   2817:        int type,t;
                   2818:        DCP dc;
                   2819:
                   2820:        if ( !p )
                   2821:                return 0;
                   2822:        else if ( NUM(p) )
                   2823:                return NID((Num)p);
                   2824:        else {
                   2825:                type = 0;
                   2826:                for ( dc = DC(p); dc; dc = NEXT(dc) ) {
                   2827:                        t = get_field_type(COEF(dc));
                   2828:                        if ( !t )
                   2829:                                continue;
                   2830:                        if ( t < 0 )
                   2831:                                return t;
                   2832:                        if ( !type )
                   2833:                                type = t;
                   2834:                        else if ( t != type )
                   2835:                                return -1;
                   2836:                }
                   2837:                return type;
1.52      noro     2838:        }
                   2839: }
                   2840:
                   2841: void Pdpv_ord(NODE arg,Obj *rp)
                   2842: {
                   2843:        int ac,id;
                   2844:        LIST shift;
                   2845:
                   2846:        ac = argc(arg);
                   2847:        if ( ac ) {
                   2848:                id = QTOS((Q)ARG0(arg));
                   2849:                if ( ac > 1 && ARG1(arg) && OID((Obj)ARG1(arg))==O_LIST )
                   2850:                        shift = (LIST)ARG1(arg);
                   2851:                else
                   2852:                        shift = 0;
                   2853:                create_modorder_spec(id,shift,&dp_current_modspec);
                   2854:        }
                   2855:        *rp = dp_current_modspec->obj;
                   2856: }
                   2857:
                   2858: void Pdpv_ht(NODE arg,LIST *rp)
                   2859: {
                   2860:        NODE n;
                   2861:        DP ht;
                   2862:        int pos;
                   2863:        DPV p;
                   2864:        Q q;
                   2865:
                   2866:        asir_assert(ARG0(arg),O_DPV,"dpv_ht");
                   2867:        p = (DPV)ARG0(arg);
                   2868:        pos = dpv_hp(p);
                   2869:        if ( pos < 0 )
                   2870:                ht = 0;
                   2871:        else
                   2872:                dp_ht(BDY(p)[pos],&ht);
                   2873:        STOQ(pos,q);
                   2874:        n = mknode(2,q,ht);
                   2875:        MKLIST(*rp,n);
                   2876: }
                   2877:
                   2878: void Pdpv_hm(NODE arg,LIST *rp)
                   2879: {
                   2880:        NODE n;
                   2881:        DP ht;
                   2882:        int pos;
                   2883:        DPV p;
                   2884:        Q q;
                   2885:
                   2886:        asir_assert(ARG0(arg),O_DPV,"dpv_hm");
                   2887:        p = (DPV)ARG0(arg);
                   2888:        pos = dpv_hp(p);
                   2889:        if ( pos < 0 )
                   2890:                ht = 0;
                   2891:        else
                   2892:                dp_hm(BDY(p)[pos],&ht);
                   2893:        STOQ(pos,q);
                   2894:        n = mknode(2,q,ht);
                   2895:        MKLIST(*rp,n);
                   2896: }
                   2897:
                   2898: void Pdpv_hc(NODE arg,LIST *rp)
                   2899: {
                   2900:        NODE n;
                   2901:        P hc;
                   2902:        int pos;
                   2903:        DPV p;
                   2904:        Q q;
                   2905:
                   2906:        asir_assert(ARG0(arg),O_DPV,"dpv_hc");
                   2907:        p = (DPV)ARG0(arg);
                   2908:        pos = dpv_hp(p);
                   2909:        if ( pos < 0 )
                   2910:                hc = 0;
                   2911:        else
                   2912:                hc = BDY(BDY(p)[pos])->c;
                   2913:        STOQ(pos,q);
                   2914:        n = mknode(2,q,hc);
                   2915:        MKLIST(*rp,n);
                   2916: }
                   2917:
                   2918: int dpv_hp(DPV p)
                   2919: {
                   2920:        int len,i,maxp,maxw,w,slen;
                   2921:        int *shift;
                   2922:        DP *e;
                   2923:
                   2924:        len = p->len;
                   2925:        e = p->body;
                   2926:        slen = dp_current_modspec->len;
                   2927:        shift = dp_current_modspec->degree_shift;
                   2928:        switch ( dp_current_modspec->id ) {
                   2929:                case ORD_REVGRADLEX:
                   2930:                        for ( maxp = -1, i = 0; i < len; i++ )
                   2931:                                if ( !e[i] ) continue;
                   2932:                                else if ( maxp < 0 ) {
                   2933:                                        maxw = BDY(e[i])->dl->td+(i<slen?shift[i]:0); maxp = i;
                   2934:                                } else {
                   2935:                                        w = BDY(e[i])->dl->td+(i<slen?shift[i]:0);
                   2936:                                        if ( w >= maxw ) {
                   2937:                                                maxw = w; maxp = i;
                   2938:                                        }
                   2939:                                }
                   2940:                        return maxp;
                   2941:                case ORD_GRADLEX:
                   2942:                        for ( maxp = -1, i = 0; i < len; i++ )
                   2943:                                if ( !e[i] ) continue;
                   2944:                                else if ( maxp < 0 ) {
                   2945:                                        maxw = BDY(e[i])->dl->td+(i<slen?shift[i]:0); maxp = i;
                   2946:                                } else {
                   2947:                                        w = BDY(e[i])->dl->td+(i<slen?shift[i]:0);
                   2948:                                        if ( w > maxw ) {
                   2949:                                                maxw = w; maxp = i;
                   2950:                                        }
                   2951:                                }
                   2952:                        return maxp;
                   2953:                        break;
                   2954:                case ORD_LEX:
                   2955:                        for ( i = 0; i < len; i++ )
                   2956:                                if ( e[i] ) return i;
                   2957:                        return -1;
                   2958:                        break;
1.26      noro     2959:        }
1.15      noro     2960: }
1.81      noro     2961:
                   2962: int get_opt(char *key0,Obj *r) {
                   2963:    NODE tt,p;
                   2964:    char *key;
                   2965:
                   2966:    if ( current_option ) {
                   2967:      for ( tt = current_option; tt; tt = NEXT(tt) ) {
                   2968:        p = BDY((LIST)BDY(tt));
                   2969:        key = BDY((STRING)BDY(p));
                   2970:        /*  value = (Obj)BDY(NEXT(p)); */
                   2971:        if ( !strcmp(key,key0) )  {
                   2972:             *r = (Obj)BDY(NEXT(p));
                   2973:             return 1;
                   2974:           }
                   2975:      }
                   2976:    }
                   2977:    return 0;
                   2978: }

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