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