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

Annotation of OpenXM_contrib2/asir2000/engine/C.c, Revision 1.3

1.2       noro        1: /*
                      2:  * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
                      3:  * All rights reserved.
                      4:  *
                      5:  * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
                      6:  * non-exclusive and royalty-free license to use, copy, modify and
                      7:  * redistribute, solely for non-commercial and non-profit purposes, the
                      8:  * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
                      9:  * conditions of this Agreement. For the avoidance of doubt, you acquire
                     10:  * only a limited right to use the SOFTWARE hereunder, and FLL or any
                     11:  * third party developer retains all rights, including but not limited to
                     12:  * copyrights, in and to the SOFTWARE.
                     13:  *
                     14:  * (1) FLL does not grant you a license in any way for commercial
                     15:  * purposes. You may use the SOFTWARE only for non-commercial and
                     16:  * non-profit purposes only, such as academic, research and internal
                     17:  * business use.
                     18:  * (2) The SOFTWARE is protected by the Copyright Law of Japan and
                     19:  * international copyright treaties. If you make copies of the SOFTWARE,
                     20:  * with or without modification, as permitted hereunder, you shall affix
                     21:  * to all such copies of the SOFTWARE the above copyright notice.
                     22:  * (3) An explicit reference to this SOFTWARE and its copyright owner
                     23:  * shall be made on your publication or presentation in any form of the
                     24:  * results obtained by use of the SOFTWARE.
                     25:  * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
1.3     ! noro       26:  * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.2       noro       27:  * for such modification or the source code of the modified part of the
                     28:  * SOFTWARE.
                     29:  *
                     30:  * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
                     31:  * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
                     32:  * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
                     33:  * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
                     34:  * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
                     35:  * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
                     36:  * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
                     37:  * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
                     38:  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
                     39:  * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
                     40:  * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
                     41:  * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
                     42:  * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
                     43:  * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
                     44:  * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
                     45:  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
                     46:  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
                     47:  *
1.3     ! noro       48:  * $OpenXM: OpenXM_contrib2/asir2000/engine/C.c,v 1.2 2000/08/21 08:31:24 noro Exp $
1.2       noro       49: */
1.1       noro       50: #include "ca.h"
                     51: #include "inline.h"
                     52: #include "base.h"
                     53:
                     54: V up_var;
                     55:
                     56: /* binary has at least 32 leading 0 chars. */
                     57: void binaryton(binary,np)
                     58: char *binary;
                     59: N *np;
                     60: {
                     61:        int i,w,len;
                     62:        N n;
                     63:        char buf[33];
                     64:
                     65:        binary += strlen(binary)%32;
                     66:        len = strlen(binary);
                     67:        w = len/32; /* sufficient for holding binary */
                     68:        n = NALLOC(w);
                     69:        for ( i = 0; i < w; i++ ) {
                     70:                strncpy(buf,binary+len-32*(i+1),32); buf[32] = 0;
                     71:                n->b[i] = strtoul(buf,0,2);
                     72:        }
                     73:        for ( i = w-1; i >= 0 && !n->b[i]; i-- );
                     74:        if ( i < 0 )
                     75:                *np = 0;
                     76:        else {
                     77:                n->p = i+1;
                     78:                *np = n;
                     79:        }
                     80: }
                     81:
                     82: /* hex has at least 8 leading 0 chars. */
                     83: void hexton(hex,np)
                     84: char *hex;
                     85: N *np;
                     86: {
                     87:        int i,w,len;
                     88:        N n;
                     89:        char buf[9];
                     90:
                     91:        hex += strlen(hex)%8;
                     92:        len = strlen(hex);
                     93:        w = len/8; /* sufficient for holding hex */
                     94:        n = NALLOC(w);
                     95:        for ( i = 0; i < w; i++ ) {
                     96:                strncpy(buf,hex+len-8*(i+1),8); buf[8] = 0;
                     97:                n->b[i] = strtoul(buf,0,16);
                     98:        }
                     99:        for ( i = w-1; i >= 0 && !n->b[i]; i-- );
                    100:        if ( i < 0 )
                    101:                *np = 0;
                    102:        else {
                    103:                n->p = i+1;
                    104:                *np = n;
                    105:        }
                    106: }
                    107:
                    108: void ntobn(base,n,nrp)
                    109: int base;
                    110: N n,*nrp;
                    111: {
                    112:        int i,d,plc;
                    113:        unsigned int *c,*x,*w;
                    114:        unsigned int r;
                    115:        L m;
                    116:        N nr;
                    117:
                    118:        if ( !n ) {
                    119:                *nrp = NULL;
                    120:                return;
                    121:        }
                    122:
                    123:        d = PL(n);
                    124:        w = BD(n);
                    125:
                    126:        for ( i = 1, m = 1; m <= LBASE/(L)base; m *= base, i++ );
                    127:
                    128:        c = (unsigned int *)W_ALLOC(d*i+1);
                    129:        x = (unsigned int *)W_ALLOC(d+1);
                    130:        for ( i = 0; i < d; i++ )
                    131:                x[i] = w[i];
                    132:        for ( plc = 0; d >= 1; plc++ ) {
                    133:                for ( i = d - 1, r = 0; i >= 0; i-- ) {
                    134:                        DSAB((unsigned int)base,r,x[i],x[i],r)
                    135:                }
                    136:                c[plc] = r;
                    137:                if ( !x[d-1] ) d--;
                    138:        }
                    139:
                    140:        *nrp = nr = NALLOC(plc); INITRC(nr);
                    141:        PL(nr) = plc;
                    142:        for ( i = 0; i < plc; i++ )
                    143:                BD(nr)[i] = c[i];
                    144: }
                    145:
                    146: void bnton(base,n,nrp)
                    147: int base;
                    148: N n,*nrp;
                    149: {
                    150:        unsigned int carry;
                    151:        unsigned int *x,*w;
                    152:        int i,j,d,plc;
                    153:        N nr;
                    154:
                    155:        if ( !n ) {
                    156:                *nrp = 0;
                    157:                return;
                    158:        }
                    159:
                    160:        d = PL(n);
                    161:        w = BD(n);
                    162:        x = (unsigned int *)W_ALLOC(d + 1);
                    163:
                    164:        for ( plc = 0, i = d - 1; i >= 0; i-- ) {
                    165:                for ( carry = w[i],j = 0; j < plc; j++ ) {
                    166:                        DMA(x[j],(unsigned int)base,carry,carry,x[j])
                    167:                }
                    168:                if ( carry ) x[plc++] = carry;
                    169:        }
                    170:        *nrp = nr = NALLOC(plc); INITRC(nr);
                    171:        PL(nr) = plc;
                    172:        for ( i = 0; i < plc; i++ )
                    173:                BD(nr)[i] = x[i];
                    174: }
                    175:
                    176: void ptomp(m,p,pr)
                    177: int m;
                    178: P p;
                    179: P *pr;
                    180: {
                    181:        DCP dc,dcr,dcr0;
                    182:        Q q;
                    183:        unsigned int a,b;
                    184:        P t;
                    185:        MQ s;
                    186:
                    187:        if ( !p )
                    188:                *pr = 0;
                    189:        else if ( NUM(p) ) {
                    190:                q = (Q)p;
                    191:                a = rem(NM(q),m);
                    192:                if ( a && (SGN(q) < 0) )
                    193:                        a = m-a;
                    194:                b = !DN(q)?1:rem(DN(q),m);
                    195:                if ( !b )
                    196:                        error("ptomp : denominator = 0");
                    197:                a = dmar(a,invm(b,m),0,m); STOMQ(a,s); *pr = (P)s;
                    198:        } else {
                    199:                for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
                    200:                        ptomp(m,COEF(dc),&t);
                    201:                        if ( t ) {
                    202:                                NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
                    203:                        }
                    204:                }
                    205:                if ( !dcr0 )
                    206:                        *pr = 0;
                    207:                else {
                    208:                        NEXT(dcr) = 0; MKP(VR(p),dcr0,*pr);
                    209:                }
                    210:        }
                    211: }
                    212:
                    213: void mptop(f,gp)
                    214: P f;
                    215: P *gp;
                    216: {
                    217:        DCP dc,dcr,dcr0;
                    218:        Q q;
                    219:
                    220:        if ( !f )
                    221:                *gp = 0;
                    222:        else if ( NUM(f) )
                    223:                STOQ(CONT((MQ)f),q),*gp = (P)q;
                    224:        else {
                    225:                for ( dc = DC(f), dcr0 = 0; dc; dc = NEXT(dc) ) {
                    226:                        NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); mptop(COEF(dc),&COEF(dcr));
                    227:                }
                    228:                NEXT(dcr) = 0; MKP(VR(f),dcr0,*gp);
                    229:        }
                    230: }
                    231:
                    232: void ptolmp(p,pr)
                    233: P p;
                    234: P *pr;
                    235: {
                    236:        DCP dc,dcr,dcr0;
                    237:        LM a;
                    238:        P t;
                    239:
                    240:        if ( !p )
                    241:                *pr = 0;
                    242:        else if ( NUM(p) ) {
                    243:                qtolm((Q)p,&a); *pr = (P)a;
                    244:        } else {
                    245:                for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
                    246:                        ptolmp(COEF(dc),&t);
                    247:                        if ( t ) {
                    248:                                NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
                    249:                        }
                    250:                }
                    251:                if ( !dcr0 )
                    252:                        *pr = 0;
                    253:                else {
                    254:                        NEXT(dcr) = 0; MKP(VR(p),dcr0,*pr);
                    255:                }
                    256:        }
                    257: }
                    258:
                    259: void lmptop(f,gp)
                    260: P f;
                    261: P *gp;
                    262: {
                    263:        DCP dc,dcr,dcr0;
                    264:        Q q;
                    265:
                    266:        if ( !f )
                    267:                *gp = 0;
                    268:        else if ( NUM(f) ) {
                    269:                NTOQ(((LM)f)->body,1,q); *gp = (P)q;
                    270:        } else {
                    271:                for ( dc = DC(f), dcr0 = 0; dc; dc = NEXT(dc) ) {
                    272:                        NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); lmptop(COEF(dc),&COEF(dcr));
                    273:                }
                    274:                NEXT(dcr) = 0; MKP(VR(f),dcr0,*gp);
                    275:        }
                    276: }
                    277:
                    278: void ptoum(m,f,wf)
                    279: int m;
                    280: P f;
                    281: UM wf;
                    282: {
                    283:        unsigned int r;
                    284:        int i;
                    285:        DCP dc;
                    286:
                    287:        for ( i = UDEG(f); i >= 0; i-- )
                    288:                COEF(wf)[i] = 0;
                    289:
                    290:        for ( dc = DC(f); dc; dc = NEXT(dc) ) {
                    291:                r = rem(NM((Q)COEF(dc)),m);
                    292:                if ( r && (SGN((Q)COEF(dc)) < 0) )
                    293:                        r = m-r;
                    294:                COEF(wf)[QTOS(DEG(dc))] = r;
                    295:        }
                    296:        degum(wf,UDEG(f));
                    297: }
                    298:
                    299: void umtop(v,w,f)
                    300: V v;
                    301: UM w;
                    302: P *f;
                    303: {
                    304:        int *c;
                    305:        DCP dc,dc0;
                    306:        int i;
                    307:        Q q;
                    308:
                    309:        if ( DEG(w) < 0 )
                    310:                *f = 0;
                    311:        else if ( DEG(w) == 0 )
                    312:                STOQ(COEF(w)[0],q), *f = (P)q;
                    313:        else {
                    314:                for ( i = DEG(w), c = COEF(w), dc0 = 0; i >= 0; i-- )
                    315:                        if ( c[i] ) {
                    316:                                NEXTDC(dc0,dc);
                    317:                                STOQ(i,DEG(dc));
                    318:                                STOQ(c[i],q), COEF(dc) = (P)q;
                    319:                        }
                    320:                NEXT(dc) = 0;
                    321:                MKP(v,dc0,*f);
                    322:        }
                    323: }
                    324:
                    325: void ptoup(n,nr)
                    326: P n;
                    327: UP *nr;
                    328: {
                    329:        DCP dc;
                    330:        UP r;
                    331:        int d;
                    332:
                    333:        if ( !n )
                    334:                *nr = 0;
                    335:        else if ( OID(n) == O_N ) {
                    336:                *nr = r = UPALLOC(0);
                    337:                DEG(r) = 0; COEF(r)[0] = (Num)n;
                    338:        } else {
                    339:                d = UDEG(n);
                    340:                up_var = VR(n);
                    341:                *nr = r = UPALLOC(d); DEG(r) = d;
                    342:                for ( dc = DC(n); dc; dc = NEXT(dc) ) {
                    343:                        COEF(r)[QTOS(DEG(dc))] = (Num)COEF(dc);
                    344:                }
                    345:        }
                    346: }
                    347:
                    348: void uptop(n,nr)
                    349: UP n;
                    350: P *nr;
                    351: {
                    352:        int i;
                    353:        DCP dc0,dc;
                    354:
                    355:        if ( !n )
                    356:                *nr = 0;
                    357:        else if ( !DEG(n) )
                    358:                *nr = (P)COEF(n)[0];
                    359:        else {
                    360:                for ( i = DEG(n), dc0 = 0; i >= 0; i-- )
                    361:                        if ( COEF(n)[i] ) {
                    362:                                NEXTDC(dc0,dc); STOQ(i,DEG(dc)); COEF(dc) = (P)COEF(n)[i];
                    363:                        }
                    364:                if ( !up_var )
                    365:                        up_var = CO->v;
                    366:                MKP(up_var,dc0,*nr);
                    367:        }
                    368: }
                    369:
                    370: void ulmptoum(m,f,wf)
                    371: int m;
                    372: UP f;
                    373: UM wf;
                    374: {
                    375:        int i,d;
                    376:        LM *c;
                    377:
                    378:        if ( !f )
                    379:                wf->d = -1;
                    380:        else {
                    381:                wf->d = d = f->d;
                    382:                c = (LM *)f->c;
                    383:                for ( i = 0, d = f->d; i <= d; i++ )
                    384:                        COEF(wf)[i] = rem(c[i]->body,m);
                    385:        }
                    386: }
                    387:
                    388: void objtobobj(base,p,rp)
                    389: int base;
                    390: Obj p;
                    391: Obj *rp;
                    392: {
                    393:        if ( !p )
                    394:                *rp = 0;
                    395:        else
                    396:                switch ( OID(p) ) {
                    397:                        case O_N:
                    398:                                numtobnum(base,(Num)p,(Num *)rp); break;
                    399:                        case O_P:
                    400:                                ptobp(base,(P)p,(P *)rp); break;
                    401:                        case O_LIST:
                    402:                                listtoblist(base,(LIST)p,(LIST *)rp); break;
                    403:                        case O_VECT:
                    404:                                vecttobvect(base,(VECT)p,(VECT *)rp); break;
                    405:                        case O_MAT:
                    406:                                mattobmat(base,(MAT)p,(MAT *)rp); break;
                    407:                        case O_STR:
                    408:                                *rp = p; break;
                    409:                        case O_COMP: default:
                    410:                                error("objtobobj : not implemented"); break;
                    411:                }
                    412: }
                    413:
                    414: void bobjtoobj(base,p,rp)
                    415: int base;
                    416: Obj p;
                    417: Obj *rp;
                    418: {
                    419:        if ( !p )
                    420:                *rp = 0;
                    421:        else
                    422:                switch ( OID(p) ) {
                    423:                        case O_N:
                    424:                                bnumtonum(base,(Num)p,(Num *)rp); break;
                    425:                        case O_P:
                    426:                                bptop(base,(P)p,(P *)rp); break;
                    427:                        case O_LIST:
                    428:                                blisttolist(base,(LIST)p,(LIST *)rp); break;
                    429:                        case O_VECT:
                    430:                                bvecttovect(base,(VECT)p,(VECT *)rp); break;
                    431:                        case O_MAT:
                    432:                                bmattomat(base,(MAT)p,(MAT *)rp); break;
                    433:                        case O_STR:
                    434:                                *rp = p; break;
                    435:                        case O_COMP: default:
                    436:                                error("bobjtoobj : not implemented"); break;
                    437:                }
                    438: }
                    439:
                    440: void numtobnum(base,p,rp)
                    441: int base;
                    442: Num p;
                    443: Num *rp;
                    444: {
                    445:        N nm,dn,body;
                    446:        Q q;
                    447:        LM l;
                    448:
                    449:        if ( !p )
                    450:                *rp = 0;
                    451:        else
                    452:                switch ( NID(p) ) {
                    453:                        case N_Q:
                    454:                                ntobn(base,NM((Q)p),&nm);
                    455:                                if ( DN((Q)p) ) {
                    456:                                        ntobn(base,DN((Q)p),&dn);
                    457:                                        NDTOQ(nm,dn,SGN((Q)p),q);
                    458:                                } else
                    459:                                        NTOQ(nm,SGN((Q)p),q);
                    460:                                *rp = (Num)q;
                    461:                                break;
                    462:                        case N_R:
                    463:                                *rp = p; break;
                    464:                        case N_LM:
                    465:                                ntobn(base,((LM)p)->body,&body);
                    466:                                MKLM(body,l); *rp = (Num)l;
                    467:                                break;
                    468:                        default:
                    469:                                error("numtobnum : not implemented"); break;
                    470:                }
                    471: }
                    472:
                    473: void bnumtonum(base,p,rp)
                    474: int base;
                    475: Num p;
                    476: Num *rp;
                    477: {
                    478:        N nm,dn,body;
                    479:        Q q;
                    480:        LM l;
                    481:
                    482:        if ( !p )
                    483:                *rp = 0;
                    484:        else
                    485:                switch ( NID(p) ) {
                    486:                        case N_Q:
                    487:                                bnton(base,NM((Q)p),&nm);
                    488:                                if ( DN((Q)p) ) {
                    489:                                        bnton(base,DN((Q)p),&dn);
                    490:                                        NDTOQ(nm,dn,SGN((Q)p),q);
                    491:                                } else
                    492:                                        NTOQ(nm,SGN((Q)p),q);
                    493:                                *rp = (Num)q;
                    494:                                break;
                    495:                        case N_R:
                    496:                                *rp = p; break;
                    497:                        case N_LM:
                    498:                                bnton(base,((LM)p)->body,&body);
                    499:                                MKLM(body,l); *rp = (Num)l;
                    500:                                break;
                    501:                        default:
                    502:                                error("bnumtonum : not implemented"); break;
                    503:                }
                    504: }
                    505:
                    506: void ptobp(base,p,rp)
                    507: int base;
                    508: P p;
                    509: P *rp;
                    510: {
                    511:        DCP dcr0,dcr,dc;
                    512:
                    513:        if ( !p )
                    514:                *rp = p;
                    515:        else {
                    516:                for ( dcr0 = 0, dc = DC(p); dc; dc = NEXT(dc) ) {
                    517:                        NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc);
                    518:                        objtobobj(base,(Obj)COEF(dc),(Obj *)&COEF(dcr));
                    519:                }
                    520:                NEXT(dcr) = 0;
                    521:                MKP(VR(p),dcr0,*rp);
                    522:        }
                    523: }
                    524:
                    525: void bptop(base,p,rp)
                    526: int base;
                    527: P p;
                    528: P *rp;
                    529: {
                    530:        DCP dcr0,dcr,dc;
                    531:
                    532:        if ( !p )
                    533:                *rp = p;
                    534:        else {
                    535:                for ( dcr0 = 0, dc = DC(p); dc; dc = NEXT(dc) ) {
                    536:                        NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc);
                    537:                        bobjtoobj(base,(Obj)COEF(dc),(Obj *)&COEF(dcr));
                    538:                }
                    539:                NEXT(dcr) = 0;
                    540:                MKP(VR(p),dcr0,*rp);
                    541:        }
                    542: }
                    543:
                    544: void listtoblist(base,p,rp)
                    545: int base;
                    546: LIST p;
                    547: LIST *rp;
                    548: {
                    549:        NODE nr0,nr,n;
                    550:
                    551:        if ( !p )
                    552:                *rp = p;
                    553:        else {
                    554:                for ( nr0 = 0, n = BDY(p); n; n = NEXT(n) ) {
                    555:                        NEXTNODE(nr0,nr);
                    556:                        objtobobj(base,BDY(n),(Obj *)&BDY(nr));
                    557:                }
                    558:                NEXT(nr) = 0;
                    559:                MKLIST(*rp,nr0);
                    560:        }
                    561: }
                    562:
                    563: void blisttolist(base,p,rp)
                    564: int base;
                    565: LIST p;
                    566: LIST *rp;
                    567: {
                    568:        NODE nr0,nr,n;
                    569:
                    570:        if ( !p )
                    571:                *rp = p;
                    572:        else {
                    573:                for ( nr0 = 0, n = BDY(p); n; n = NEXT(n) ) {
                    574:                        NEXTNODE(nr0,nr);
                    575:                        bobjtoobj(base,BDY(n),(Obj *)&BDY(nr));
                    576:                }
                    577:                NEXT(nr) = 0;
                    578:                MKLIST(*rp,nr0);
                    579:        }
                    580: }
                    581:
                    582: void vecttobvect(base,p,rp)
                    583: int base;
                    584: VECT p;
                    585: VECT *rp;
                    586: {
                    587:        int i,l;
                    588:        VECT r;
                    589:
                    590:        if ( !p )
                    591:                *rp = p;
                    592:        else {
                    593:                l = p->len;
                    594:                MKVECT(r,l); *rp = r;
                    595:                for ( i = 0; i < l; i++ )
                    596:                        objtobobj(base,p->body[i],(Obj *)&r->body[i]);
                    597:        }
                    598: }
                    599:
                    600: void bvecttovect(base,p,rp)
                    601: int base;
                    602: VECT p;
                    603: VECT *rp;
                    604: {
                    605:        int i,l;
                    606:        VECT r;
                    607:
                    608:        if ( !p )
                    609:                *rp = p;
                    610:        else {
                    611:                l = p->len;
                    612:                MKVECT(r,l); *rp = r;
                    613:                for ( i = 0; i < l; i++ )
                    614:                        bobjtoobj(base,p->body[i],(Obj *)&r->body[i]);
                    615:        }
                    616: }
                    617:
                    618: void mattobmat(base,p,rp)
                    619: int base;
                    620: MAT p;
                    621: MAT *rp;
                    622: {
                    623:        int row,col,i,j;
                    624:        MAT r;
                    625:
                    626:        if ( !p )
                    627:                *rp = p;
                    628:        else {
                    629:                row = p->row; col = p->col;
                    630:                MKMAT(r,row,col); *rp = r;
                    631:                for ( i = 0; i < row; i++ )
                    632:                        for ( j = 0; i < col; j++ )
                    633:                        objtobobj(base,p->body[i][j],(Obj *)&r->body[i][j]);
                    634:        }
                    635: }
                    636:
                    637: void bmattomat(base,p,rp)
                    638: int base;
                    639: MAT p;
                    640: MAT *rp;
                    641: {
                    642:        int row,col,i,j;
                    643:        MAT r;
                    644:
                    645:        if ( !p )
                    646:                *rp = p;
                    647:        else {
                    648:                row = p->row; col = p->col;
                    649:                MKMAT(r,row,col); *rp = r;
                    650:                for ( i = 0; i < row; i++ )
                    651:                        for ( j = 0; i < col; j++ )
                    652:                        bobjtoobj(base,p->body[i][j],(Obj *)&r->body[i][j]);
                    653:        }
                    654: }
                    655:
                    656: void n32ton27(g,rp)
                    657: N g;
                    658: N *rp;
                    659: {
                    660:        int i,j,k,l,r,bits,words;
                    661:        unsigned int t;
                    662:        unsigned int *a,*b;
                    663:        N z;
                    664:
                    665:        l = PL(g); a = BD(g);
                    666:        for ( i = 31, t = a[l-1]; !(t&(1<<i)); i-- );
                    667:        bits = (l-1)*32+i+1; words = (bits+26)/27;
                    668:        *rp = z = NALLOC(words); PL(z) = words;
                    669:        bzero((char *)BD(z),words*sizeof(unsigned int));
                    670:        for ( j = 0, b = BD(z); j < words; j++ ) {
                    671:                k = (27*j)/32; r = (27*j)%32;
                    672:                if ( r > 5 )
                    673:                        b[j] = (a[k]>>r)|(k==(l-1)?0:((a[k+1]&((1<<(r-5))-1))<<(32-r)));
                    674:                else
                    675:                        b[j] = (a[k]>>r)&((1<<27)-1);
                    676:        }
                    677:        if ( !(r = bits%27) )
                    678:                r = 27;
                    679:        b[words-1] &= ((1<<r)-1);
                    680: }
                    681:
                    682: void n27ton32(a,rp)
                    683: N a;
                    684: N *rp;
                    685: {
                    686:        int i,j,k,l,r,bits,words;
                    687:        unsigned int t;
                    688:        unsigned int *b,*c;
                    689:        N z;
                    690:
                    691:        l = PL(a); b = BD(a);
                    692:        for ( i = 26, t = b[l-1]; !(t&(1<<i)); i-- );
                    693:        bits = (l-1)*27+i+1; words = (bits+31)/32;
                    694:        *rp = z = NALLOC(words); PL(z) = words;
                    695:        bzero((char *)BD(z),words*sizeof(unsigned int));
                    696:        for ( j = 0, c = BD(z); j < l; j++ ) {
                    697:                k = (27*j)/32; r = (27*j)%32;
                    698:                if ( r > 5 ) {
                    699:                        c[k] |= (b[j]&((1<<(32-r))-1))<<r;
                    700:                        if ( k+1 < words )
                    701:                                c[k+1] = (b[j]>>(32-r));
                    702:                } else
                    703:                        c[k] |= (b[j]<<r);
                    704:        }
                    705: }
                    706:
                    707: void mptoum(p,pr)
                    708: P p;
                    709: UM pr;
                    710: {
                    711:        DCP dc;
                    712:
                    713:        if ( !p )
                    714:                DEG(pr) = -1;
                    715:        else if ( NUM(p) ) {
                    716:                DEG(pr) = 0; COEF(pr)[0] = CONT((MQ)p);
                    717:        } else {
                    718:                bzero((char *)pr,(int)((UDEG(p)+2)*sizeof(int)));
                    719:                for ( dc = DC(p); dc; dc = NEXT(dc) )
                    720:                        COEF(pr)[QTOS(DEG(dc))] = CONT((MQ)COEF(dc));
                    721:                degum(pr,UDEG(p));
                    722:        }
                    723: }
                    724:
                    725: void umtomp(v,p,pr)
                    726: V v;
                    727: UM p;
                    728: P *pr;
                    729: {
                    730:        DCP dc,dc0;
                    731:        int i;
                    732:        MQ q;
                    733:
                    734:        if ( !p || (DEG(p) < 0) )
                    735:                *pr = 0;
                    736:        else if ( !DEG(p) )
                    737:                STOMQ(COEF(p)[0],q), *pr = (P)q;
                    738:        else {
                    739:                for ( dc0 = 0, i = DEG(p); i >= 0; i-- )
                    740:                        if ( COEF(p)[i] ) {
                    741:                                NEXTDC(dc0,dc); STOQ(i,DEG(dc));
                    742:                                STOMQ(COEF(p)[i],q), COEF(dc) = (P)q;
                    743:                        }
                    744:                NEXT(dc) = 0; MKP(v,dc0,*pr);
                    745:        }
                    746: }

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