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