![[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: }