=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/io/bload.c,v retrieving revision 1.3 retrieving revision 1.21 diff -u -p -r1.3 -r1.21 --- OpenXM_contrib2/asir2000/io/bload.c 2000/08/22 05:04:17 1.3 +++ OpenXM_contrib2/asir2000/io/bload.c 2020/10/04 03:14:08 1.21 @@ -44,416 +44,436 @@ * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. - * $OpenXM: OpenXM_contrib2/asir2000/io/bload.c,v 1.2 2000/08/21 08:31:38 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/io/bload.c,v 1.20 2019/11/12 10:52:04 kondoh Exp $ */ #include "ca.h" #include "parse.h" -#if INET #include "com.h" -#endif -#if PARI -#include "genpari.h" -int get_lg(GEN); -#endif +#include "ox.h" -void loaderror(FILE *,ERR *); -void loadui(FILE *,USINT *); -void loaddp(FILE *,DP *); -void loadstr(FILE *,char **); -void loadstring(FILE *,STRING *); -void loadmat(FILE *,MAT *); -void loadvect(FILE *,VECT *); -void loadlist(FILE *,LIST *); -void loadr(FILE *,R *); -void loadp(FILE *,P *); -void loadgf2n(FILE *,GF2N *); -void loadgfpn(FILE *,GFPN *); -void loadlm(FILE *,LM *); -void loadmi(FILE *,MQ *); -void loadcplx(FILE *,C *); -void loadbf(FILE *,BF *); -void loadreal(FILE *,Real *); -void loadq(FILE *,Q *); -void loadnum(FILE *,Num *); -void loadgfmmat(FILE *,GFMMAT *); - -V loadpfins(FILE *); - extern VL file_vl; +void loadnbp(FILE *s,NBP *p); + void (*loadf[])() = { 0, loadnum, loadp, loadr, loadlist, loadvect, loadmat, - loadstring, 0, loaddp, loadui, loaderror,0,0,0,loadgfmmat }; -void (*nloadf[])() = { loadq, loadreal, 0, loadbf, loadcplx, loadmi, loadlm, loadgf2n, loadgfpn }; + loadstring, 0, loaddp, loadui, loaderror,0,0,0,loadgfmmat, + loadbytearray, 0, 0, 0, 0, 0, 0, 0, 0, loadnbp }; -void loadobj(s,p) -FILE *s; -Obj *p; +#if defined(INTERVAL) +void loaditv(); +void loaditvd(); +void (*nloadf[])() = { loadq, loadreal, 0, loadbf, loaditv, loaditvd, 0, loaditv, loadcplx, loadmi, loadlm, loadgf2n, loadgfpn, loadgfs, loadgfsn, loaddalg }; +#else +void (*nloadf[])() = { loadq, loadreal, 0, loadbf, loadcplx, loadmi, loadlm, loadgf2n, loadgfpn, loadgfs, loadgfsn, loaddalg }; +#endif + +void loadobj(FILE *s,Obj *p) { - short id; + short id; - read_short(s,&id); - if ( !id ) - *p = 0; - else if ( !loadf[id] ) - error("loadobj : not implemented"); - else - (*loadf[id])(s,p); + read_short(s,&id); + if ( !id ) + *p = 0; + else if ( !loadf[id] ) + error("loadobj : not implemented"); + else + (*loadf[id])(s,p); } -void loadnum(s,p) -FILE *s; -Num *p; +void loadnum(FILE *s,Num *p) { - char nid; + char nid; - read_char(s,&nid); - if ( !nloadf[nid] ) - error("loadnum : not implemented"); - else - (*nloadf[nid])(s,p); + read_char(s,&nid); + if ( !nloadf[nid] ) + error("loadnum : not implemented"); + else + (*nloadf[nid])(s,p); } -void loadq(s,p) -FILE *s; -Q *p; +void loadq(FILE *s,Q *p) { - int size[2]; - char sgn; - int len = 2; - N nm,dn; + int size[2]; + char sgn; + int len = 2; + N nm,dn; - read_char(s,&sgn); read_intarray(s,size,len); - nm = NALLOC(size[0]); PL(nm) = size[0]; - read_intarray(s,BD(nm),size[0]); - if ( size[1] ) { - dn = NALLOC(size[1]); PL(dn) = size[1]; - read_intarray(s,BD(dn),size[1]); - } else - dn = 0; - NDTOQ(nm,dn,sgn,*p); + read_char(s,&sgn); read_intarray(s,size,len); + nm = NALLOC(size[0]); PL(nm) = size[0]; + read_intarray(s,BD(nm),size[0]); + if ( size[1] ) { + dn = NALLOC(size[1]); PL(dn) = size[1]; + read_intarray(s,BD(dn),size[1]); + } else + dn = 0; + NDTOQ(nm,dn,sgn,*p); } -void loadreal(s,p) -FILE *s; -Real *p; +void loadreal(FILE *s,Real *p) { - Real q; - char dmy; + Real q; + char dmy; - read_char(s,&dmy); - NEWReal(q); read_double(s,&BDY(q)); - *p = q; + read_char(s,&dmy); + NEWReal(q); read_double(s,&BDY(q)); + *p = q; } -void loadbf(s,p) -FILE *s; -BF *p; +void loadbf(FILE *s,BF *p) { -#if PARI - GEN z; - unsigned int uexpo,lexpo; - UL expo; - char dmy; - int sign; - unsigned int len; - BF q; + BF r; + char dmy; + int sgn,prec; + UL exp; - read_char(s,&dmy); - read_int(s,&sign); - read_int(s,&uexpo); - read_int(s,&lexpo); - -#if defined(LONG_IS_32BIT) - if ( uexpo ) - error("loadbf : exponent too large"); - read_int(s,&len); - NEWBF(q,len+2); - z = (GEN)BDY(q); - settyp(z,t_REAL); - setlg(z,len+2); - setsigne(z,(long)sign); - setexpo(z,(long)lexpo); - read_intarray(s,(int *)(z+2),len); -#elif defined(LONG_IS_64BIT) - expo = (((UL)uexpo)<<32)|((UL)lexpo); - read_int(s,&len); - NEWBF(q,(len+5)/2); /* 2+(len+1)/2 */ - z = (GEN)BDY(q); - settyp(z,t_REAL); - setlg(z,(len+5)/2); - setsigne(z,(long)sign); - setexpo(z,(long)expo); - read_longarray(s,z+2,len); + int len; + read_char(s,&dmy); + NEWBF(r); + read_int(s,&sgn); + read_int(s,&prec); + read_int64(s,&exp); + read_int(s,&len); + mpfr_init2(r->body,prec); + MPFR_SIGN(r->body) = sgn; + MPFR_EXP(r->body) = (int)exp; +#if defined(VISUAL) +#if !defined(_WIN64) + read_intarray(s,(int *)r->body->_mpfr_d,len); +#else + read_longarray(s,(long long*)r->body->_mpfr_d,len); #endif - *p = q; #else - error("loadbf : PARI is not combined"); +#if SIZEOF_LONG == 4 + read_intarray(s,(int *)r->body->_mpfr_d,len); +#else /* SIZEOF_LONG == 8 */ + read_longarray(s,(long *)r->body->_mpfr_d,len); #endif +#endif + *p = r; } -void loadcplx(s,p) -FILE *s; -C *p; +#if defined(INTERVAL) +void loaditv(FILE *s,Itv *p) { - C q; - char dmy; + Itv q; + char dmy; - read_char(s,&dmy); - NEWC(q); loadobj(s,(Obj *)&q->r); loadobj(s,(Obj *)&q->i); - *p = q; + read_char(s,&dmy); + NEWItvP(q); loadobj(s,(Obj *)&INF(q)); loadobj(s,(Obj *)&SUP(q)); + *p = q; } -void loadmi(s,p) -FILE *s; -MQ *p; +void loaditvd(FILE *s,IntervalDouble *p) { - MQ q; - char dmy; + IntervalDouble q; + char dmy; - read_char(s,&dmy); - NEWMQ(q); read_int(s,(int *)&CONT(q)); - *p = q; + read_char(s,&dmy); + NEWIntervalDouble(q); + read_double(s,&INF(q)); + read_double(s,&SUP(q)); + *p = q; } +#endif -void loadlm(s,p) -FILE *s; -LM *p; +void loadcplx(FILE *s,C *p) { - int size; - char dmy; - N body; + C q; + char dmy; - read_char(s,&dmy); read_int(s,&size); - body = NALLOC(size); PL(body) = size; - read_intarray(s,BD(body),size); - MKLM(body,*p); + read_char(s,&dmy); + NEWC(q); loadobj(s,(Obj *)&q->r); loadobj(s,(Obj *)&q->i); + *p = q; } -void loadgf2n(s,p) -FILE *s; -GF2N *p; +void loadmi(FILE *s,MQ *p) { - char dmy; - int len; - UP2 body; + MQ q; + char dmy; - read_char(s,&dmy); read_int(s,&len); - NEWUP2(body,len); body->w = len; - read_intarray(s,body->b,len); - MKGF2N(body,*p); + read_char(s,&dmy); + NEWMQ(q); read_int(s,(int *)&CONT(q)); + *p = q; } -void loadgfpn(s,p) -FILE *s; -GFPN *p; +void loadlm(FILE *s,LM *p) { - char dmy; - int d,i; - UP body; + int size; + char dmy; + N body; - read_char(s,&dmy); read_int(s,&d); - body = UPALLOC(d); - body->d = d; - for ( i = 0; i <= d; i++ ) - loadobj(s,(Obj *)&body->c[i]); - MKGFPN(body,*p); + read_char(s,&dmy); read_int(s,&size); + body = NALLOC(size); PL(body) = size; + read_intarray(s,BD(body),size); + MKLM(body,*p); } -void loadp(s,p) -FILE *s; -P *p; +void loadgf2n(FILE *s,GF2N *p) { - V v; - int n,vindex; - DCP dc,dc0; - P t; + char dmy; + int len; + UP2 body; - read_int(s,&vindex); - if ( vindex < 0 ) - /* v is a pure function */ - v = loadpfins(s); - else - v = (V)load_convv(vindex); - read_int(s,&n); - for ( dc0 = 0; n; n-- ) { - NEXTDC(dc0,dc); loadobj(s,(Obj *)&DEG(dc)); loadobj(s,(Obj *)&COEF(dc)); - } - NEXT(dc) = 0; - MKP(v,dc0,t); - if ( vindex < 0 || file_vl ) - reorderp(CO,file_vl,t,p); - else - *p = t; + read_char(s,&dmy); read_int(s,&len); + NEWUP2(body,len); body->w = len; + read_intarray(s,body->b,len); + MKGF2N(body,*p); } +void loadgfpn(FILE *s,GFPN *p) +{ + char dmy; + int d,i; + UP body; + + read_char(s,&dmy); read_int(s,&d); + body = UPALLOC(d); + body->d = d; + for ( i = 0; i <= d; i++ ) + loadobj(s,(Obj *)&body->c[i]); + MKGFPN(body,*p); +} + +void loadgfs(FILE *s,GFS *p) +{ + GFS q; + char dmy; + + read_char(s,&dmy); + NEWGFS(q); read_int(s,(int *)&CONT(q)); + *p = q; +} + +void loadgfsn(FILE *s,GFSN *p) +{ + char dmy; + int d; + UM body; + + read_char(s,&dmy); read_int(s,&d); + body = UMALLOC(d); DEG(body) = d; + read_intarray(s,COEF(body),d+1); + MKGFSN(body,*p); +} + +void loaddalg(FILE *s,DAlg *p) +{ + char dmy; + Obj nm,dn; + + read_char(s,&dmy); + loadobj(s,&nm); + loadobj(s,&dn); + MKDAlg((DP)nm,(Q)dn,*p); +} + +void loadp(FILE *s,P *p) +{ + V v; + int n,vindex; + DCP dc,dc0; + P t; + + read_int(s,&vindex); + if ( vindex < 0 ) + /* v is a pure function */ + v = loadpfins(s); + else + v = (V)load_convv(vindex); + read_int(s,&n); + for ( dc0 = 0; n; n-- ) { + NEXTDC(dc0,dc); loadobj(s,(Obj *)&DEG(dc)); loadobj(s,(Obj *)&COEF(dc)); + } + NEXT(dc) = 0; + MKP(v,dc0,t); + if ( vindex < 0 || file_vl ) + reorderp(CO,file_vl,t,p); + else + *p = t; +} + /* |name(str)|argc(int)|darray(intarray)|args| */ -V loadpfins(s) -FILE *s; +V loadpfins(FILE *s) { - char *name; - FUNC fp; - int argc,i; - V v; - int *darray; - Obj *args; - PF pf; - char *buf; - V *a; - P u; + char *name; + FUNC fp; + int argc,i; + V v; + int *darray; + Obj *args; + PF pf; + char *buf; + V *a; + P u; - loadstr(s,&name); - read_int(s,&argc); - searchpf(name,&fp); - if ( fp ) { - pf = fp->f.puref; - if ( pf->argc != argc ) - error("loadpfins : argument mismatch"); - } else { - a = (V *)MALLOC(argc*sizeof(V)); - buf = (char *)ALLOCA(BUFSIZ); - for ( i = 0; i < argc; i++ ) { - sprintf(buf,"_%c",'a'+i); - makevar(buf,&u); a[i] = VR(u); - } - mkpf(name,0,argc,a,0,0,0,&pf); - } - darray = (int *)ALLOCA(argc*sizeof(int)); - args = (Obj *)ALLOCA(argc*sizeof(int)); - read_intarray(s,darray,argc); - for ( i = 0; i < argc; i++ ) - loadobj(s,&args[i]); - _mkpfins_with_darray(pf,args,darray,&v); - return v; + loadstr(s,&name); + read_int(s,&argc); + searchpf(name,&fp); + if ( fp ) { + pf = fp->f.puref; + if ( pf->argc != argc ) + error("loadpfins : argument mismatch"); + } else { + a = (V *)MALLOC(argc*sizeof(V)); + buf = (char *)ALLOCA(BUFSIZ); + for ( i = 0; i < argc; i++ ) { + sprintf(buf,"_%c",'a'+i); + makevar(buf,&u); a[i] = VR(u); + } +#if defined(INTERVAL) + mkpf(name,0,argc,a,0,0,0,0,&pf); +#else + mkpf(name,0,argc,a,0,0,0,&pf); +#endif + } + darray = (int *)ALLOCA(argc*sizeof(int)); + args = (Obj *)ALLOCA(argc*sizeof(int)); + read_intarray(s,darray,argc); + for ( i = 0; i < argc; i++ ) + loadobj(s,&args[i]); + _mkpfins_with_darray(pf,args,darray,&v); + return v; } -void loadr(s,p) -FILE *s; -R *p; +void loadr(FILE *s,R *p) { - R r; + R r; - NEWR(r); read_short(s,&r->reduced); - loadobj(s,(Obj *)&NM(r)); loadobj(s,(Obj *)&DN(r)); *p = r; + NEWR(r); read_short(s,&r->reduced); + loadobj(s,(Obj *)&NM(r)); loadobj(s,(Obj *)&DN(r)); *p = r; } -void loadlist(s,p) -FILE *s; -LIST *p; +void loadlist(FILE *s,LIST *p) { - int n; - NODE tn,tn0; + int n; + NODE tn,tn0; - read_int(s,&n); - for ( tn0 = 0; n; n-- ) { - NEXTNODE(tn0,tn); loadobj(s,(Obj *)&BDY(tn)); - } - if ( tn0 ) - NEXT(tn) = 0; - MKLIST(*p,tn0); + read_int(s,&n); + for ( tn0 = 0; n; n-- ) { + NEXTNODE(tn0,tn); loadobj(s,(Obj *)&BDY(tn)); + } + if ( tn0 ) + NEXT(tn) = 0; + MKLIST(*p,tn0); } -void loadvect(s,p) -FILE *s; -VECT *p; +void loadvect(FILE *s,VECT *p) { - int i,len; - VECT vect; + int i,len; + VECT vect; - read_int(s,&len); MKVECT(vect,len); - for ( i = 0; i < len; i++ ) - loadobj(s,(Obj *)&BDY(vect)[i]); - *p = vect; + read_int(s,&len); MKVECT(vect,len); + for ( i = 0; i < len; i++ ) + loadobj(s,(Obj *)&BDY(vect)[i]); + *p = vect; } -void loadmat(s,p) -FILE *s; -MAT *p; +void loadmat(FILE *s,MAT *p) { - int row,col,i,j; - MAT mat; + int row,col,i,j; + MAT mat; - read_int(s,&row); read_int(s,&col); MKMAT(mat,row,col); - for ( i = 0; i < row; i++ ) - for ( j = 0; j < col; j++ ) - loadobj(s,(Obj *)&BDY(mat)[i][j]); - *p = mat; + read_int(s,&row); read_int(s,&col); MKMAT(mat,row,col); + for ( i = 0; i < row; i++ ) + for ( j = 0; j < col; j++ ) + loadobj(s,(Obj *)&BDY(mat)[i][j]); + *p = mat; } -void loadstring(s,p) -FILE *s; -STRING *p; +void loadstring(FILE *s,STRING *p) { - char *t; + char *t; - loadstr(s,&t); MKSTR(*p,t); + loadstr(s,&t); MKSTR(*p,t); } -void loadstr(s,p) -FILE *s; -char **p; +void loadstr(FILE *s,char **p) { - int len; - char *t; + int len; + char *t; - read_int(s,&len); - if ( len ) { - t = (char *)MALLOC(len+1); read_string(s,t,len); t[len] = 0; - } else - t = ""; - *p = t; + read_int(s,&len); + if ( len ) { + t = (char *)MALLOC(len+1); read_string(s,t,len); t[len] = 0; + } else + t = ""; + *p = t; } -void loaddp(s,p) -FILE *s; -DP *p; +void loadbytearray(FILE *s,BYTEARRAY *p) { - int nv,n,i,sugar; - DP dp; - MP m,m0; - DL dl; + int len; + BYTEARRAY array; - read_int(s,&nv); read_int(s,&sugar); read_int(s,&n); - for ( i = 0, m0 = 0; i < n; i++ ) { - NEXTMP(m0,m); - loadobj(s,(Obj *)&(m->c)); - NEWDL(dl,nv); m->dl = dl; - read_int(s,&dl->td); read_intarray(s,&(dl->d[0]),nv); - } - NEXT(m) = 0; MKDP(nv,m0,dp); dp->sugar = sugar; *p = dp; + read_int(s,&len); + MKBYTEARRAY(array,len); + if ( len ) { + read_string(s,array->body,len); + } + *p = array; } -void loadui(s,u) -FILE *s; -USINT *u; +void loaddp(FILE *s,DP *p) { - unsigned int b; + int nv,n,i,sugar; + DP dp; + MP m,m0; + DL dl; - read_int(s,&b); MKUSINT(*u,b); + read_int(s,&nv); read_int(s,&sugar); read_int(s,&n); + for ( i = 0, m0 = 0; i < n; i++ ) { + NEXTMP(m0,m); + loadobj(s,(Obj *)&(m->c)); + NEWDL(dl,nv); m->dl = dl; + read_int(s,&dl->td); read_intarray(s,&(dl->d[0]),nv); + } + NEXT(m) = 0; MKDP(nv,m0,dp); dp->sugar = sugar; *p = dp; } -void loaderror(s,e) -FILE *s; -ERR *e; +void loadui(FILE *s,USINT *u) { - Obj b; + unsigned int b; - loadobj(s,&b); MKERR(*e,b); + read_int(s,&b); MKUSINT(*u,b); } +void loaderror(FILE *s,ERR *e) +{ + Obj b; -void loadgfmmat(s,p) -FILE *s; -GFMMAT *p; + loadobj(s,&b); MKERR(*e,b); +} + + +void loadgfmmat(FILE *s,GFMMAT *p) { - int i,j,row,col; - unsigned int **a; - GFMMAT mat; + int i,row,col; + unsigned int **a; + GFMMAT mat; - read_int(s,&row); read_int(s,&col); - a = (unsigned int **)almat(row,col); - TOGFMMAT(row,col,a,mat); - for ( i = 0; i < row; i++ ) - read_intarray(s,a[i],col); - *p = mat; + read_int(s,&row); read_int(s,&col); + a = (unsigned int **)almat(row,col); + TOGFMMAT(row,col,a,mat); + for ( i = 0; i < row; i++ ) + read_intarray(s,a[i],col); + *p = mat; +} + +void loadnbp(FILE *s,NBP *p) +{ + int n,i; + NBM m; + NODE r0,r; + + read_int(s,&n); + for ( i = 0, r0 = 0; i < n; i++ ) { + NEWNBM(m); + loadobj(s,(Obj *)&m->c); + read_int(s,&m->d); + NEWNBMBDY(m,m->d); read_intarray(s,m->b,(m->d+31)/32); + NEXTNODE(r0,r); BDY(r) = (pointer)m; + } + if ( r0 ) NEXT(r) = 0; + MKNBP(*p,r0); }