![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to bload.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / io|
Return to bload.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / io |
1.1 ! noro 1: /* $OpenXM: OpenXM/src/asir99/io/bload.c,v 1.1.1.1 1999/11/10 08:12:30 noro Exp $ */
! 2: #include "ca.h"
! 3: #include "parse.h"
! 4: #if INET
! 5: #include "com.h"
! 6: #endif
! 7: #if PARI
! 8: #include "genpari.h"
! 9: int get_lg(GEN);
! 10: #endif
! 11:
! 12: void loaderror(FILE *,ERR *);
! 13: void loadui(FILE *,USINT *);
! 14: void loaddp(FILE *,DP *);
! 15: void loadstr(FILE *,char **);
! 16: void loadstring(FILE *,STRING *);
! 17: void loadmat(FILE *,MAT *);
! 18: void loadvect(FILE *,VECT *);
! 19: void loadlist(FILE *,LIST *);
! 20: void loadr(FILE *,R *);
! 21: void loadp(FILE *,P *);
! 22: void loadgf2n(FILE *,GF2N *);
! 23: void loadgfpn(FILE *,GFPN *);
! 24: void loadlm(FILE *,LM *);
! 25: void loadmi(FILE *,MQ *);
! 26: void loadcplx(FILE *,C *);
! 27: void loadbf(FILE *,BF *);
! 28: void loadreal(FILE *,Real *);
! 29: void loadq(FILE *,Q *);
! 30: void loadnum(FILE *,Num *);
! 31: void loadgfmmat(FILE *,GFMMAT *);
! 32:
! 33: V loadpfins(FILE *);
! 34:
! 35: extern VL file_vl;
! 36:
! 37: void (*loadf[])() = { 0, loadnum, loadp, loadr, loadlist, loadvect, loadmat,
! 38: loadstring, 0, loaddp, loadui, loaderror,0,0,0,loadgfmmat };
! 39: void (*nloadf[])() = { loadq, loadreal, 0, loadbf, loadcplx, loadmi, loadlm, loadgf2n, loadgfpn };
! 40:
! 41: void loadobj(s,p)
! 42: FILE *s;
! 43: Obj *p;
! 44: {
! 45: short id;
! 46:
! 47: read_short(s,&id);
! 48: if ( !id )
! 49: *p = 0;
! 50: else if ( !loadf[id] )
! 51: error("loadobj : not implemented");
! 52: else
! 53: (*loadf[id])(s,p);
! 54: }
! 55:
! 56: void loadnum(s,p)
! 57: FILE *s;
! 58: Num *p;
! 59: {
! 60: char nid;
! 61:
! 62: read_char(s,&nid);
! 63: if ( !nloadf[nid] )
! 64: error("loadnum : not implemented");
! 65: else
! 66: (*nloadf[nid])(s,p);
! 67: }
! 68:
! 69: void loadq(s,p)
! 70: FILE *s;
! 71: Q *p;
! 72: {
! 73: int size[2];
! 74: char sgn;
! 75: int len = 2;
! 76: N nm,dn;
! 77:
! 78: read_char(s,&sgn); read_intarray(s,size,len);
! 79: nm = NALLOC(size[0]); PL(nm) = size[0];
! 80: read_intarray(s,BD(nm),size[0]);
! 81: if ( size[1] ) {
! 82: dn = NALLOC(size[1]); PL(dn) = size[1];
! 83: read_intarray(s,BD(dn),size[1]);
! 84: } else
! 85: dn = 0;
! 86: NDTOQ(nm,dn,sgn,*p);
! 87: }
! 88:
! 89: void loadreal(s,p)
! 90: FILE *s;
! 91: Real *p;
! 92: {
! 93: Real q;
! 94: char dmy;
! 95:
! 96: read_char(s,&dmy);
! 97: NEWReal(q); read_double(s,&BDY(q));
! 98: *p = q;
! 99: }
! 100:
! 101: void loadbf(s,p)
! 102: FILE *s;
! 103: BF *p;
! 104: {
! 105: #if PARI
! 106: GEN z;
! 107: unsigned int uexpo,lexpo;
! 108: UL expo;
! 109: char dmy;
! 110: int sign;
! 111: unsigned int len;
! 112: BF q;
! 113:
! 114: read_char(s,&dmy);
! 115: read_int(s,&sign);
! 116: read_int(s,&uexpo);
! 117: read_int(s,&lexpo);
! 118:
! 119: #if defined(LONG_IS_32BIT)
! 120: if ( uexpo )
! 121: error("loadbf : exponent too large");
! 122: read_int(s,&len);
! 123: NEWBF(q,len+2);
! 124: z = (GEN)BDY(q);
! 125: settyp(z,t_REAL);
! 126: setlg(z,len+2);
! 127: setsigne(z,(long)sign);
! 128: setexpo(z,(long)lexpo);
! 129: read_intarray(s,(int *)(z+2),len);
! 130: #elif defined(LONG_IS_64BIT)
! 131: expo = (((UL)uexpo)<<32)|((UL)lexpo);
! 132: read_int(s,&len);
! 133: NEWBF(q,(len+5)/2); /* 2+(len+1)/2 */
! 134: z = (GEN)BDY(q);
! 135: settyp(z,t_REAL);
! 136: setlg(z,(len+5)/2);
! 137: setsigne(z,(long)sign);
! 138: setexpo(z,(long)expo);
! 139: read_longarray(s,z+2,len);
! 140: #endif
! 141: *p = q;
! 142: #else
! 143: error("loadbf : PARI is not combined");
! 144: #endif
! 145: }
! 146:
! 147: void loadcplx(s,p)
! 148: FILE *s;
! 149: C *p;
! 150: {
! 151: C q;
! 152: char dmy;
! 153:
! 154: read_char(s,&dmy);
! 155: NEWC(q); loadobj(s,(Obj *)&q->r); loadobj(s,(Obj *)&q->i);
! 156: *p = q;
! 157: }
! 158:
! 159: void loadmi(s,p)
! 160: FILE *s;
! 161: MQ *p;
! 162: {
! 163: MQ q;
! 164: char dmy;
! 165:
! 166: read_char(s,&dmy);
! 167: NEWMQ(q); read_int(s,(int *)&CONT(q));
! 168: *p = q;
! 169: }
! 170:
! 171: void loadlm(s,p)
! 172: FILE *s;
! 173: LM *p;
! 174: {
! 175: int size;
! 176: char dmy;
! 177: N body;
! 178:
! 179: read_char(s,&dmy); read_int(s,&size);
! 180: body = NALLOC(size); PL(body) = size;
! 181: read_intarray(s,BD(body),size);
! 182: MKLM(body,*p);
! 183: }
! 184:
! 185: void loadgf2n(s,p)
! 186: FILE *s;
! 187: GF2N *p;
! 188: {
! 189: char dmy;
! 190: int len;
! 191: UP2 body;
! 192:
! 193: read_char(s,&dmy); read_int(s,&len);
! 194: NEWUP2(body,len); body->w = len;
! 195: read_intarray(s,body->b,len);
! 196: MKGF2N(body,*p);
! 197: }
! 198:
! 199: void loadgfpn(s,p)
! 200: FILE *s;
! 201: GFPN *p;
! 202: {
! 203: char dmy;
! 204: int d,i;
! 205: UP body;
! 206:
! 207: read_char(s,&dmy); read_int(s,&d);
! 208: body = UPALLOC(d);
! 209: body->d = d;
! 210: for ( i = 0; i <= d; i++ )
! 211: loadobj(s,(Obj *)&body->c[i]);
! 212: MKGFPN(body,*p);
! 213: }
! 214:
! 215: void loadp(s,p)
! 216: FILE *s;
! 217: P *p;
! 218: {
! 219: V v;
! 220: int n,vindex;
! 221: DCP dc,dc0;
! 222: P t;
! 223:
! 224: read_int(s,&vindex);
! 225: if ( vindex < 0 )
! 226: /* v is a pure function */
! 227: v = loadpfins(s);
! 228: else
! 229: v = (V)load_convv(vindex);
! 230: read_int(s,&n);
! 231: for ( dc0 = 0; n; n-- ) {
! 232: NEXTDC(dc0,dc); loadobj(s,(Obj *)&DEG(dc)); loadobj(s,(Obj *)&COEF(dc));
! 233: }
! 234: NEXT(dc) = 0;
! 235: MKP(v,dc0,t);
! 236: if ( vindex < 0 || file_vl )
! 237: reorderp(CO,file_vl,t,p);
! 238: else
! 239: *p = t;
! 240: }
! 241:
! 242: /* |name(str)|argc(int)|darray(intarray)|args| */
! 243:
! 244: V loadpfins(s)
! 245: FILE *s;
! 246: {
! 247: char *name;
! 248: FUNC fp;
! 249: int argc,i;
! 250: V v;
! 251: int *darray;
! 252: Obj *args;
! 253: PF pf;
! 254: char *buf;
! 255: V *a;
! 256: P u;
! 257:
! 258: loadstr(s,&name);
! 259: read_int(s,&argc);
! 260: searchpf(name,&fp);
! 261: if ( fp ) {
! 262: pf = fp->f.puref;
! 263: if ( pf->argc != argc )
! 264: error("loadpfins : argument mismatch");
! 265: } else {
! 266: a = (V *)MALLOC(argc*sizeof(V));
! 267: buf = (char *)ALLOCA(BUFSIZ);
! 268: for ( i = 0; i < argc; i++ ) {
! 269: sprintf(buf,"_%c",'a'+i);
! 270: makevar(buf,&u); a[i] = VR(u);
! 271: }
! 272: mkpf(name,0,argc,a,0,0,0,&pf);
! 273: }
! 274: darray = (int *)ALLOCA(argc*sizeof(int));
! 275: args = (Obj *)ALLOCA(argc*sizeof(int));
! 276: read_intarray(s,darray,argc);
! 277: for ( i = 0; i < argc; i++ )
! 278: loadobj(s,&args[i]);
! 279: _mkpfins_with_darray(pf,args,darray,&v);
! 280: return v;
! 281: }
! 282:
! 283: void loadr(s,p)
! 284: FILE *s;
! 285: R *p;
! 286: {
! 287: R r;
! 288:
! 289: NEWR(r); read_short(s,&r->reduced);
! 290: loadobj(s,(Obj *)&NM(r)); loadobj(s,(Obj *)&DN(r)); *p = r;
! 291: }
! 292:
! 293: void loadlist(s,p)
! 294: FILE *s;
! 295: LIST *p;
! 296: {
! 297: int n;
! 298: NODE tn,tn0;
! 299:
! 300: read_int(s,&n);
! 301: for ( tn0 = 0; n; n-- ) {
! 302: NEXTNODE(tn0,tn); loadobj(s,(Obj *)&BDY(tn));
! 303: }
! 304: if ( tn0 )
! 305: NEXT(tn) = 0;
! 306: MKLIST(*p,tn0);
! 307: }
! 308:
! 309: void loadvect(s,p)
! 310: FILE *s;
! 311: VECT *p;
! 312: {
! 313: int i,len;
! 314: VECT vect;
! 315:
! 316: read_int(s,&len); MKVECT(vect,len);
! 317: for ( i = 0; i < len; i++ )
! 318: loadobj(s,(Obj *)&BDY(vect)[i]);
! 319: *p = vect;
! 320: }
! 321:
! 322: void loadmat(s,p)
! 323: FILE *s;
! 324: MAT *p;
! 325: {
! 326: int row,col,i,j;
! 327: MAT mat;
! 328:
! 329: read_int(s,&row); read_int(s,&col); MKMAT(mat,row,col);
! 330: for ( i = 0; i < row; i++ )
! 331: for ( j = 0; j < col; j++ )
! 332: loadobj(s,(Obj *)&BDY(mat)[i][j]);
! 333: *p = mat;
! 334: }
! 335:
! 336: void loadstring(s,p)
! 337: FILE *s;
! 338: STRING *p;
! 339: {
! 340: char *t;
! 341:
! 342: loadstr(s,&t); MKSTR(*p,t);
! 343: }
! 344:
! 345: void loadstr(s,p)
! 346: FILE *s;
! 347: char **p;
! 348: {
! 349: int len;
! 350: char *t;
! 351:
! 352: read_int(s,&len);
! 353: if ( len ) {
! 354: t = (char *)MALLOC(len+1); read_string(s,t,len); t[len] = 0;
! 355: } else
! 356: t = "";
! 357: *p = t;
! 358: }
! 359:
! 360: void loaddp(s,p)
! 361: FILE *s;
! 362: DP *p;
! 363: {
! 364: int nv,n,i,sugar;
! 365: DP dp;
! 366: MP m,m0;
! 367: DL dl;
! 368:
! 369: read_int(s,&nv); read_int(s,&sugar); read_int(s,&n);
! 370: for ( i = 0, m0 = 0; i < n; i++ ) {
! 371: NEXTMP(m0,m);
! 372: loadobj(s,(Obj *)&(m->c));
! 373: NEWDL(dl,nv); m->dl = dl;
! 374: read_int(s,&dl->td); read_intarray(s,&(dl->d[0]),nv);
! 375: }
! 376: NEXT(m) = 0; MKDP(nv,m0,dp); dp->sugar = sugar; *p = dp;
! 377: }
! 378:
! 379: void loadui(s,u)
! 380: FILE *s;
! 381: USINT *u;
! 382: {
! 383: unsigned int b;
! 384:
! 385: read_int(s,&b); MKUSINT(*u,b);
! 386: }
! 387:
! 388: void loaderror(s,e)
! 389: FILE *s;
! 390: ERR *e;
! 391: {
! 392: Obj b;
! 393:
! 394: loadobj(s,&b); MKERR(*e,b);
! 395: }
! 396:
! 397:
! 398: void loadgfmmat(s,p)
! 399: FILE *s;
! 400: GFMMAT *p;
! 401: {
! 402: int i,j,row,col;
! 403: unsigned int **a;
! 404: GFMMAT mat;
! 405:
! 406: read_int(s,&row); read_int(s,&col);
! 407: a = (unsigned int **)almat(row,col);
! 408: TOGFMMAT(row,col,a,mat);
! 409: for ( i = 0; i < row; i++ )
! 410: read_intarray(s,a[i],col);
! 411: *p = mat;
! 412: }