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

Annotation of OpenXM_contrib2/asir2000/io/bload.c, Revision 1.9

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.
1.9     ! noro       47:  * $OpenXM: OpenXM_contrib2/asir2000/io/bload.c,v 1.8 2001/03/16 01:56:18 noro Exp $
1.2       noro       48: */
1.1       noro       49: #include "ca.h"
                     50: #include "parse.h"
                     51: #include "com.h"
                     52: #if PARI
                     53: #include "genpari.h"
                     54: int get_lg(GEN);
                     55: #endif
                     56:
                     57: void loaderror(FILE *,ERR *);
                     58: void loadui(FILE *,USINT *);
                     59: void loaddp(FILE *,DP *);
                     60: void loadstr(FILE *,char **);
                     61: void loadstring(FILE *,STRING *);
                     62: void loadmat(FILE *,MAT *);
                     63: void loadvect(FILE *,VECT *);
                     64: void loadlist(FILE *,LIST *);
                     65: void loadr(FILE *,R *);
                     66: void loadp(FILE *,P *);
                     67: void loadgf2n(FILE *,GF2N *);
                     68: void loadgfpn(FILE *,GFPN *);
1.8       noro       69: void loadgfs(FILE *,GFS *);
1.9     ! noro       70: void loadgfsn(FILE *,GFSN *);
1.1       noro       71: void loadlm(FILE *,LM *);
                     72: void loadmi(FILE *,MQ *);
                     73: void loadcplx(FILE *,C *);
                     74: void loadbf(FILE *,BF *);
                     75: void loadreal(FILE *,Real *);
                     76: void loadq(FILE *,Q *);
                     77: void loadnum(FILE *,Num *);
                     78: void loadgfmmat(FILE *,GFMMAT *);
1.4       noro       79: void loadbytearray(FILE *,BYTEARRAY *);
1.1       noro       80:
                     81: V loadpfins(FILE *);
                     82:
                     83: extern VL file_vl;
                     84:
                     85: void (*loadf[])() = { 0, loadnum, loadp, loadr, loadlist, loadvect, loadmat,
1.4       noro       86:        loadstring, 0, loaddp, loadui, loaderror,0,0,0,loadgfmmat, loadbytearray };
1.6       saito      87: #if defined(INTERVAL)
1.7       saito      88: void loaditv();
                     89: void loaditvd();
1.9     ! noro       90: void (*nloadf[])() = { loadq, loadreal, 0, loadbf, loaditv, loaditvd, 0, loaditv, loadcplx, loadmi, loadlm, loadgf2n, loadgfpn, loadgfs, loadgfsn };
1.6       saito      91: #else
1.9     ! noro       92: void (*nloadf[])() = { loadq, loadreal, 0, loadbf, loadcplx, loadmi, loadlm, loadgf2n, loadgfpn, loadgfs, loadgfsn };
1.6       saito      93: #endif
1.1       noro       94:
                     95: void loadobj(s,p)
                     96: FILE *s;
                     97: Obj *p;
                     98: {
                     99:        short id;
                    100:
                    101:        read_short(s,&id);
                    102:        if ( !id )
                    103:                *p = 0;
                    104:        else if ( !loadf[id] )
                    105:                error("loadobj : not implemented");
                    106:        else
                    107:                (*loadf[id])(s,p);
                    108: }
                    109:
                    110: void loadnum(s,p)
                    111: FILE *s;
                    112: Num *p;
                    113: {
                    114:        char nid;
                    115:
                    116:        read_char(s,&nid);
                    117:        if ( !nloadf[nid] )
                    118:                error("loadnum : not implemented");
                    119:        else
                    120:                (*nloadf[nid])(s,p);
                    121: }
                    122:
                    123: void loadq(s,p)
                    124: FILE *s;
                    125: Q *p;
                    126: {
                    127:        int size[2];
                    128:        char sgn;
                    129:        int len = 2;
                    130:        N nm,dn;
                    131:
                    132:        read_char(s,&sgn); read_intarray(s,size,len);
                    133:        nm = NALLOC(size[0]); PL(nm) = size[0];
                    134:        read_intarray(s,BD(nm),size[0]);
                    135:        if ( size[1] ) {
                    136:                dn = NALLOC(size[1]); PL(dn) = size[1];
                    137:                read_intarray(s,BD(dn),size[1]);
                    138:        } else
                    139:                dn = 0;
                    140:        NDTOQ(nm,dn,sgn,*p);
                    141: }
                    142:
                    143: void loadreal(s,p)
                    144: FILE *s;
                    145: Real *p;
                    146: {
                    147:        Real q;
                    148:        char dmy;
                    149:
                    150:        read_char(s,&dmy);
                    151:        NEWReal(q); read_double(s,&BDY(q));
                    152:        *p = q;
                    153: }
                    154:
                    155: void loadbf(s,p)
                    156: FILE *s;
                    157: BF *p;
                    158: {
                    159: #if PARI
                    160:        GEN z;
                    161:        unsigned int uexpo,lexpo;
                    162:        UL expo;
                    163:        char dmy;
                    164:        int sign;
                    165:        unsigned int len;
                    166:        BF q;
                    167:
                    168:        read_char(s,&dmy);
                    169:        read_int(s,&sign);
                    170:        read_int(s,&uexpo);
                    171:        read_int(s,&lexpo);
                    172:
                    173: #if defined(LONG_IS_32BIT)
                    174:        if ( uexpo )
                    175:                error("loadbf : exponent too large");
                    176:        read_int(s,&len);
                    177:        NEWBF(q,len+2);
                    178:        z = (GEN)BDY(q);
                    179:        settyp(z,t_REAL);
                    180:        setlg(z,len+2);
                    181:        setsigne(z,(long)sign);
                    182:        setexpo(z,(long)lexpo);
                    183:        read_intarray(s,(int *)(z+2),len);
                    184: #elif defined(LONG_IS_64BIT)
                    185:        expo = (((UL)uexpo)<<32)|((UL)lexpo);
                    186:        read_int(s,&len);
                    187:        NEWBF(q,(len+5)/2); /* 2+(len+1)/2 */
                    188:        z = (GEN)BDY(q);
                    189:        settyp(z,t_REAL);
                    190:        setlg(z,(len+5)/2);
                    191:        setsigne(z,(long)sign);
                    192:        setexpo(z,(long)expo);
                    193:        read_longarray(s,z+2,len);
                    194: #endif
                    195:        *p = q;
                    196: #else
                    197:        error("loadbf : PARI is not combined");
                    198: #endif
                    199: }
1.6       saito     200:
                    201: #if defined(INTERVAL)
1.7       saito     202: void loaditv(s,p)
1.6       saito     203: FILE *s;
                    204: Itv *p;
                    205: {
                    206:        Itv q;
                    207:        char dmy;
                    208:
                    209:        read_char(s,&dmy);
                    210:        NEWItvP(q); loadobj(s,(Obj *)&INF(q)); loadobj(s,(Obj *)&SUP(q));
                    211:        *p = q;
                    212: }
                    213:
1.7       saito     214: void loaditvd(s,p)
1.6       saito     215: FILE *s;
                    216: ItvD *p;
                    217: {
                    218:        ItvD q;
                    219:        char dmy;
                    220:
                    221:        read_char(s,&dmy);
                    222:        NEWItvD(q);
                    223:        read_double(s,&INF(q));
                    224:        read_double(s,&SUP(q));
                    225:        *p = q;
                    226: }
                    227: #endif
1.1       noro      228:
                    229: void loadcplx(s,p)
                    230: FILE *s;
                    231: C *p;
                    232: {
                    233:        C q;
                    234:        char dmy;
                    235:
                    236:        read_char(s,&dmy);
                    237:        NEWC(q); loadobj(s,(Obj *)&q->r); loadobj(s,(Obj *)&q->i);
                    238:        *p = q;
                    239: }
                    240:
                    241: void loadmi(s,p)
                    242: FILE *s;
                    243: MQ *p;
                    244: {
                    245:        MQ q;
                    246:        char dmy;
                    247:
                    248:        read_char(s,&dmy);
                    249:        NEWMQ(q); read_int(s,(int *)&CONT(q));
                    250:        *p = q;
                    251: }
                    252:
                    253: void loadlm(s,p)
                    254: FILE *s;
                    255: LM *p;
                    256: {
                    257:        int size;
                    258:        char dmy;
                    259:        N body;
                    260:
                    261:        read_char(s,&dmy); read_int(s,&size);
                    262:        body = NALLOC(size); PL(body) = size;
                    263:        read_intarray(s,BD(body),size);
                    264:        MKLM(body,*p);
                    265: }
                    266:
                    267: void loadgf2n(s,p)
                    268: FILE *s;
                    269: GF2N *p;
                    270: {
                    271:        char dmy;
                    272:        int len;
                    273:        UP2 body;
                    274:
                    275:        read_char(s,&dmy); read_int(s,&len);
                    276:        NEWUP2(body,len); body->w = len;
                    277:        read_intarray(s,body->b,len);
                    278:        MKGF2N(body,*p);
                    279: }
                    280:
                    281: void loadgfpn(s,p)
                    282: FILE *s;
                    283: GFPN *p;
                    284: {
                    285:        char dmy;
                    286:        int d,i;
                    287:        UP body;
                    288:
                    289:        read_char(s,&dmy); read_int(s,&d);
                    290:        body = UPALLOC(d);
                    291:        body->d = d;
                    292:        for ( i = 0; i <= d; i++ )
                    293:                loadobj(s,(Obj *)&body->c[i]);
                    294:        MKGFPN(body,*p);
1.8       noro      295: }
                    296:
                    297: void loadgfs(s,p)
                    298: FILE *s;
                    299: GFS *p;
                    300: {
                    301:        GFS q;
                    302:        char dmy;
                    303:
                    304:        read_char(s,&dmy);
                    305:        NEWGFS(q); read_int(s,(int *)&CONT(q));
                    306:        *p = q;
1.9     ! noro      307: }
        !           308:
        !           309: void loadgfsn(s,p)
        !           310: FILE *s;
        !           311: GFSN *p;
        !           312: {
        !           313:        char dmy;
        !           314:        int d;
        !           315:        UM body;
        !           316:
        !           317:        read_char(s,&dmy); read_int(s,&d);
        !           318:        body = UMALLOC(d); DEG(body) = d;
        !           319:        read_intarray(s,COEF(body),d+1);
        !           320:        MKGFSN(body,*p);
1.1       noro      321: }
                    322:
                    323: void loadp(s,p)
                    324: FILE *s;
                    325: P *p;
                    326: {
                    327:        V v;
                    328:        int n,vindex;
                    329:        DCP dc,dc0;
                    330:        P t;
                    331:
                    332:        read_int(s,&vindex);
                    333:        if ( vindex < 0 )
                    334:        /* v is a pure function */
                    335:                v = loadpfins(s);
                    336:        else
                    337:                v = (V)load_convv(vindex);
                    338:        read_int(s,&n);
                    339:        for ( dc0 = 0; n; n-- ) {
                    340:                NEXTDC(dc0,dc); loadobj(s,(Obj *)&DEG(dc)); loadobj(s,(Obj *)&COEF(dc));
                    341:        }
                    342:        NEXT(dc) = 0;
                    343:        MKP(v,dc0,t);
                    344:        if ( vindex < 0 || file_vl )
                    345:                reorderp(CO,file_vl,t,p);
                    346:        else
                    347:                *p = t;
                    348: }
                    349:
                    350: /* |name(str)|argc(int)|darray(intarray)|args| */
                    351:
                    352: V loadpfins(s)
                    353: FILE *s;
                    354: {
                    355:        char *name;
                    356:        FUNC fp;
                    357:        int argc,i;
                    358:        V v;
                    359:        int *darray;
                    360:        Obj *args;
                    361:        PF pf;
                    362:        char *buf;
                    363:        V *a;
                    364:        P u;
                    365:
                    366:        loadstr(s,&name);
                    367:        read_int(s,&argc);
                    368:        searchpf(name,&fp);
                    369:        if ( fp ) {
                    370:                pf = fp->f.puref;
                    371:                if ( pf->argc != argc )
                    372:                        error("loadpfins : argument mismatch");
                    373:        } else {
                    374:                a = (V *)MALLOC(argc*sizeof(V));
                    375:                buf = (char *)ALLOCA(BUFSIZ);
                    376:                for ( i = 0; i < argc; i++ ) {
                    377:                        sprintf(buf,"_%c",'a'+i);
                    378:                        makevar(buf,&u); a[i] = VR(u);
                    379:                }
                    380:                mkpf(name,0,argc,a,0,0,0,&pf);
                    381:        }
                    382:        darray = (int *)ALLOCA(argc*sizeof(int));
                    383:        args = (Obj *)ALLOCA(argc*sizeof(int));
                    384:        read_intarray(s,darray,argc);
                    385:        for ( i = 0; i < argc; i++ )
                    386:                loadobj(s,&args[i]);
                    387:        _mkpfins_with_darray(pf,args,darray,&v);
                    388:        return v;
                    389: }
                    390:
                    391: void loadr(s,p)
                    392: FILE *s;
                    393: R *p;
                    394: {
                    395:        R r;
                    396:
                    397:        NEWR(r); read_short(s,&r->reduced);
                    398:        loadobj(s,(Obj *)&NM(r)); loadobj(s,(Obj *)&DN(r)); *p = r;
                    399: }
                    400:
                    401: void loadlist(s,p)
                    402: FILE *s;
                    403: LIST *p;
                    404: {
                    405:        int n;
                    406:        NODE tn,tn0;
                    407:
                    408:        read_int(s,&n);
                    409:        for ( tn0 = 0; n; n-- ) {
                    410:                NEXTNODE(tn0,tn); loadobj(s,(Obj *)&BDY(tn));
                    411:        }
                    412:        if ( tn0 )
                    413:                NEXT(tn) = 0;
                    414:        MKLIST(*p,tn0);
                    415: }
                    416:
                    417: void loadvect(s,p)
                    418: FILE *s;
                    419: VECT *p;
                    420: {
                    421:        int i,len;
                    422:        VECT vect;
                    423:
                    424:        read_int(s,&len); MKVECT(vect,len);
                    425:        for ( i = 0; i < len; i++ )
                    426:                loadobj(s,(Obj *)&BDY(vect)[i]);
                    427:        *p = vect;
                    428: }
                    429:
                    430: void loadmat(s,p)
                    431: FILE *s;
                    432: MAT *p;
                    433: {
                    434:        int row,col,i,j;
                    435:        MAT mat;
                    436:
                    437:        read_int(s,&row); read_int(s,&col); MKMAT(mat,row,col);
                    438:        for ( i = 0; i < row; i++ )
                    439:                for ( j = 0; j < col; j++ )
                    440:                        loadobj(s,(Obj *)&BDY(mat)[i][j]);
                    441:        *p = mat;
                    442: }
                    443:
                    444: void loadstring(s,p)
                    445: FILE *s;
                    446: STRING *p;
                    447: {
                    448:        char *t;
                    449:
                    450:        loadstr(s,&t); MKSTR(*p,t);
                    451: }
                    452:
                    453: void loadstr(s,p)
                    454: FILE *s;
                    455: char **p;
                    456: {
                    457:        int len;
                    458:        char *t;
                    459:
                    460:        read_int(s,&len);
                    461:        if ( len ) {
                    462:                t = (char *)MALLOC(len+1); read_string(s,t,len); t[len] = 0;
                    463:        } else
                    464:                t = "";
                    465:        *p = t;
1.4       noro      466: }
                    467:
                    468: void loadbytearray(s,p)
                    469: FILE *s;
                    470: BYTEARRAY *p;
                    471: {
                    472:        int len;
                    473:        BYTEARRAY array;
                    474:
                    475:        read_int(s,&len);
                    476:        MKBYTEARRAY(array,len);
                    477:        if ( len ) {
                    478:                read_string(s,array->body,len);
                    479:        }
                    480:        *p = array;
1.1       noro      481: }
                    482:
                    483: void loaddp(s,p)
                    484: FILE *s;
                    485: DP *p;
                    486: {
                    487:        int nv,n,i,sugar;
                    488:        DP dp;
                    489:        MP m,m0;
                    490:        DL dl;
                    491:
                    492:        read_int(s,&nv); read_int(s,&sugar); read_int(s,&n);
                    493:        for ( i = 0, m0 = 0; i < n; i++ ) {
                    494:                NEXTMP(m0,m);
                    495:                loadobj(s,(Obj *)&(m->c));
                    496:                NEWDL(dl,nv); m->dl = dl;
                    497:                read_int(s,&dl->td); read_intarray(s,&(dl->d[0]),nv);
                    498:        }
                    499:        NEXT(m) = 0; MKDP(nv,m0,dp); dp->sugar = sugar; *p = dp;
                    500: }
                    501:
                    502: void loadui(s,u)
                    503: FILE *s;
                    504: USINT *u;
                    505: {
                    506:        unsigned int b;
                    507:
                    508:        read_int(s,&b); MKUSINT(*u,b);
                    509: }
                    510:
                    511: void loaderror(s,e)
                    512: FILE *s;
                    513: ERR *e;
                    514: {
                    515:        Obj b;
                    516:
                    517:        loadobj(s,&b); MKERR(*e,b);
                    518: }
                    519:
                    520:
                    521: void loadgfmmat(s,p)
                    522: FILE *s;
                    523: GFMMAT *p;
                    524: {
                    525:        int i,j,row,col;
                    526:        unsigned int **a;
                    527:        GFMMAT mat;
                    528:
                    529:        read_int(s,&row); read_int(s,&col);
                    530:        a = (unsigned int **)almat(row,col);
                    531:        TOGFMMAT(row,col,a,mat);
                    532:        for ( i = 0; i < row; i++ )
                    533:                read_intarray(s,a[i],col);
                    534:        *p = mat;
                    535: }

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