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

Annotation of OpenXM_contrib2/asir2000/io/bsave.c, Revision 1.17

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.17    ! noro       47:  * $OpenXM: OpenXM_contrib2/asir2000/io/bsave.c,v 1.16 2009/03/16 16:43:03 ohara Exp $
1.2       noro       48: */
1.1       noro       49: /* saveXXX must not use GC_malloc(), GC_malloc_atomic(). */
                     50:
                     51: #include "ca.h"
                     52: #include "parse.h"
                     53: #include "com.h"
                     54:
1.15      noro       55: void savenbp(FILE *s,NBP p);
                     56:
1.1       noro       57: void (*savef[])() = { 0, savenum, savep, saver, savelist, savevect,
1.15      noro       58:        savemat, savestring, 0, savedp, saveui, saveerror,0,0,0,savegfmmat,
                     59:        savebytearray, 0, 0, 0, 0, 0, 0, 0, 0,  savenbp };
1.6       saito      60: #if defined(INTERVAL)
1.7       saito      61: void saveitv();
                     62: void saveitvd();
1.14      noro       63: void (*nsavef[])() = { saveq, savereal, 0, savebf, saveitv, saveitvd, 0, saveitv, savecplx ,savemi, savelm, savegf2n, savegfpn, savegfs, savegfsn,savedalg};
1.6       saito      64: #else
1.14      noro       65: void (*nsavef[])() = { saveq, savereal, 0, savebf, savecplx ,savemi, savelm, savegf2n, savegfpn, savegfs, savegfsn,savedalg};
1.6       saito      66: #endif
1.1       noro       67:
                     68: static short zeroval = 0;
                     69:
1.10      noro       70: void saveobj(FILE *s,Obj p)
1.1       noro       71: {
                     72:        if ( !p )
                     73:                write_short(s,&zeroval);
                     74:        else if ( !savef[OID(p)] )
                     75:                error("saveobj : not implemented");
                     76:        else
                     77:                (*savef[OID(p)])(s,p);
                     78: }
                     79:
1.10      noro       80: void savenum(FILE *s,Num p)
1.1       noro       81: {
                     82:        if ( !nsavef[NID(p)] )
                     83:                error("savenum : not implemented");
                     84:        else {
                     85:                write_short(s,&OID(p)); write_char(s,&NID(p));
                     86:                write_char(s,&(p->pad));
                     87:                (*nsavef[NID(p)])(s,p);
                     88:        }
                     89: }
                     90:
1.10      noro       91: void saveq(FILE *s,Q p)
1.1       noro       92: {
                     93:        int size[2];
                     94:        int len = 2;
                     95:
                     96:        size[0] = PL(NM(p)); size[1] = DN(p) ? PL(DN(p)) : 0;
                     97:        write_intarray(s,size,len);
                     98:        write_intarray(s,BD(NM(p)),size[0]);
                     99:        if ( size[1] )
                    100:                write_intarray(s,BD(DN(p)),size[1]);
                    101: }
                    102:
1.10      noro      103: void savereal(FILE *s,Real p)
1.1       noro      104: { write_double(s,&BDY(p)); }
                    105:
                    106: /*
                    107:  * BDY(p) = |  z[0]  |   z[1]  | z[2] | ... | z[lg(z)-1] |
                    108:  * -> | id(2) | nid(1) | sgn(1) | expo>>32 | expo&0xffffffff | len | ... |
                    109:  */
                    110:
1.10      noro      111: void savebf(FILE *s,BF p)
1.1       noro      112: {
1.17    ! noro      113:   unsigned int zero = 0;
        !           114:   unsigned int prec;
        !           115:        L exp;
        !           116:   int sgn,len,t;
        !           117:
        !           118:   prec = MPFR_PREC(p->body);
        !           119:   exp = MPFR_EXP(p->body);
        !           120:   sgn = MPFR_SIGN(p->body);
        !           121:        len = MPFR_LIMB_SIZE(p->body);
        !           122:
        !           123:        write_int(s,&sgn);
        !           124:        write_int(s,(int *)&prec);
        !           125:        write_int64(s,(UL *)&exp);
1.16      ohara     126: #if SIZEOF_LONG == 4
1.1       noro      127:        write_int(s,&len);
1.17    ! noro      128:        write_intarray(s,p->body->_mpfr_d,len);
        !           129: #else /* SIZEOF_LONG == 8 */
        !           130:        t = 2*len;
        !           131:        write_int(s,&t);
        !           132:        write_longarray(s,p->body->_mpfr_d,len);
1.1       noro      133: #endif
                    134: }
1.6       saito     135:
                    136: #if defined(INTERVAL)
1.10      noro      137: void saveitv(FILE *s,Itv p)
1.6       saito     138: {
                    139:        saveobj(s,(Obj)INF(p));
                    140:        saveobj(s,(Obj)SUP(p));
                    141: }
                    142:
1.11      kondoh    143: void saveitvd(FILE *s,IntervalDouble p)
1.6       saito     144: {
                    145:        write_double(s,&INF(p));
                    146:        write_double(s,&SUP(p));
                    147: }
                    148: #endif
1.1       noro      149:
1.10      noro      150: void savecplx(FILE *s,C p)
1.1       noro      151: { saveobj(s,(Obj)p->r); saveobj(s,(Obj)p->i); }
                    152:
1.10      noro      153: void savemi(FILE *s,MQ p)
1.1       noro      154: { write_int(s,&CONT(p)); }
                    155:
1.10      noro      156: void savelm(FILE *s,LM p)
1.1       noro      157: {
                    158:        int size;
                    159:
                    160:        size = PL(BDY(p));
                    161:        write_int(s,&size);
                    162:        write_intarray(s,BD(BDY(p)),size);
                    163: }
                    164:
1.10      noro      165: void savegf2n(FILE *s,GF2N p)
1.1       noro      166: {
                    167:        int len;
                    168:
                    169:        len = p->body->w;
                    170:        write_int(s,&len);
                    171:        write_intarray(s,p->body->b,len);
                    172: }
                    173:
1.10      noro      174: void savegfpn(FILE *s,GFPN p)
1.1       noro      175: {
                    176:        int d,i;
                    177:
                    178:        d = p->body->d;
                    179:        write_int(s,&d);
                    180:        for ( i = 0; i <= d; i++ )
                    181:                saveobj(s,(Obj)p->body->c[i]);
                    182: }
1.8       noro      183:
1.10      noro      184: void savegfs(FILE *s,GFS p)
1.8       noro      185: { write_int(s,&CONT(p)); }
1.9       noro      186:
1.10      noro      187: void savegfsn(FILE *s,GFSN p)
1.9       noro      188: {
                    189:        int d;
                    190:
                    191:        d = DEG(BDY(p));
                    192:        write_int(s,&d);
                    193:        write_intarray(s,COEF(BDY(p)),d+1);
1.14      noro      194: }
                    195:
                    196: void savedalg(FILE *s,DAlg p)
                    197: {
1.15      noro      198:        saveobj(s,(Obj)p->nm);
                    199:        saveobj(s,(Obj)p->dn);
1.9       noro      200: }
1.1       noro      201:
1.10      noro      202: void savep(FILE *s,P p)
1.1       noro      203: {
                    204:        DCP dc;
                    205:        int n;
                    206:        int vindex;
                    207:
                    208:        if ( NUM(p) )
                    209:                savenum(s,(Num)p);
                    210:        else {
                    211:                vindex = save_convv(VR(p));
                    212:                for ( dc = DC(p), n = 0; dc; dc = NEXT(dc), n++ );
                    213:                write_short(s,&OID(p));
                    214:                write_int(s,&vindex);
                    215:                if ( vindex < 0 )
                    216:                        savepfins(s,VR(p));
                    217:                write_int(s,&n);
                    218:                for ( dc = DC(p); dc; dc = NEXT(dc) ) {
                    219:                        saveobj(s,(Obj)DEG(dc)); saveobj(s,(Obj)COEF(dc));
                    220:                }
                    221:        }
                    222: }
                    223:
                    224: /* save a pure function (v->attr = V_PF) */
                    225: /* |name(str)|argc(int)|darray(intarray)|args| */
                    226:
1.10      noro      227: void savepfins(FILE *s,V v)
1.1       noro      228: {
                    229:        PFINS ins;
                    230:        PF pf;
                    231:        int argc,i;
                    232:        int *darray;
                    233:
                    234:        ins = (PFINS)v->priv;
                    235:        pf = ins->pf;
                    236:        savestr(s,NAME(pf));
                    237:        argc = pf->argc;
                    238:        write_int(s,&argc);
                    239:        darray = (int *)ALLOCA(argc*sizeof(int));
                    240:        for ( i = 0; i < argc; i++ )
                    241:                darray[i] = ins->ad[i].d;
                    242:        write_intarray(s,darray,argc);
                    243:        for ( i = 0; i < argc; i++ )
                    244:                saveobj(s,ins->ad[i].arg);
                    245: }
                    246:
1.10      noro      247: void saver(FILE *s,R p)
1.1       noro      248: {
                    249:        if ( !RAT(p) )
                    250:                savep(s,(P)p);
                    251:        else {
                    252:                write_short(s,&OID(p)); write_short(s,&p->reduced);
                    253:                savep(s,NM(p)); savep(s,DN(p));
                    254:        }
                    255: }
                    256:
1.10      noro      257: void savelist(FILE *s,LIST p)
1.1       noro      258: {
                    259:        int n;
                    260:        NODE tn;
                    261:
                    262:        for ( tn = BDY(p), n = 0; tn; tn = NEXT(tn), n++ );
                    263:        write_short(s,&OID(p)); write_int(s,&n);
                    264:        for ( tn = BDY(p); tn; tn = NEXT(tn) )
                    265:                saveobj(s,(Obj)BDY(tn));
                    266: }
                    267:
1.10      noro      268: void savevect(FILE *s,VECT p)
1.1       noro      269: {
                    270:        int i,len = 2;
                    271:
                    272:        write_short(s,&OID(p)); write_int(s,&p->len);
                    273:        for ( i = 0, len = p->len; i < len; i++ )
                    274:                saveobj(s,(Obj)BDY(p)[i]);
                    275: }
                    276:
1.10      noro      277: void savemat(FILE *s,MAT p)
1.1       noro      278: {
                    279:        int i,j,row,col;
                    280:        int len = 3;
                    281:
                    282:        write_short(s,&OID(p)); write_int(s,&p->row); write_int(s,&p->col);
                    283:        for ( i = 0, row = p->row, col = p->col; i < row; i++ )
                    284:                for ( j = 0; j < col; j++ )
                    285:                        saveobj(s,(Obj)BDY(p)[i][j]);
                    286: }
                    287:
1.10      noro      288: void savestring(FILE *s,STRING p)
1.1       noro      289: {
                    290:        write_short(s,&OID(p)); savestr(s,BDY(p));
                    291: }
                    292:
1.10      noro      293: void savestr(FILE *s,char *p)
1.1       noro      294: {
                    295:        int size;
                    296:
                    297:        size = p ? strlen(p) : 0; write_int(s,&size);
                    298:        if ( size )
                    299:                write_string(s,p,size);
                    300: }
                    301:
1.10      noro      302: void savedp(FILE *s,DP p)
1.1       noro      303: {
                    304:        int nv,n,i,sugar;
                    305:        MP m,t;
                    306:
                    307:        nv = p->nv; m = p->body; sugar = p->sugar;
                    308:        for ( n = 0, t = m; t; t = NEXT(t), n++ );
                    309:        write_short(s,&OID(p)); write_int(s,&nv); write_int(s,&sugar); write_int(s,&n);
                    310:        for ( i = 0, t = m; i < n; i++, t = NEXT(t) ) {
                    311:                saveobj(s,(Obj)t->c);
                    312:                write_int(s,&t->dl->td); write_intarray(s,&(t->dl->d[0]),nv);
                    313:        }
                    314: }
                    315:
1.10      noro      316: void saveui(FILE *s,USINT u)
1.1       noro      317: {
                    318:        write_short(s,&OID(u)); write_int(s,&BDY(u));
                    319: }
                    320:
1.10      noro      321: void saveerror(FILE *s,ERR e)
1.1       noro      322: {
                    323:        write_short(s,&OID(e)); saveobj(s,(Obj)BDY(e));
                    324: }
                    325:
1.10      noro      326: void savegfmmat(FILE *s,GFMMAT p)
1.1       noro      327: {
1.10      noro      328:        int i,row,col;
1.1       noro      329:
                    330:        write_short(s,&OID(p)); write_int(s,&p->row); write_int(s,&p->col);
                    331:        for ( i = 0, row = p->row, col = p->col; i < row; i++ )
                    332:                write_intarray(s,p->body[i],col);
1.4       noro      333: }
                    334:
1.10      noro      335: void savebytearray(FILE *s,BYTEARRAY p)
1.4       noro      336: {
                    337:        write_short(s,&OID(p)); write_int(s,&p->len);
                    338:        write_string(s,p->body,p->len);
1.15      noro      339: }
                    340:
                    341: void savenbp(FILE *s,NBP p)
                    342: {
                    343:        int i,n;
                    344:        NODE t;
                    345:        NBM m;
                    346:
                    347:        write_short(s,&OID(p));
                    348:        for ( n = 0, t = BDY(p); t; t = NEXT(t), n++ );
                    349:        write_int(s,&n);
                    350:        for ( i = 0, t = BDY(p); i < n; t = NEXT(t), i++ ) {
                    351:                m = (NBM)BDY(t);
                    352:                saveobj(s,(Obj)m->c);
                    353:                write_int(s,&m->d);
                    354:                write_intarray(s,m->b,(m->d+31)/32);
                    355:        }
1.1       noro      356: }

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