![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to cio.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 cio.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / io |
1.1 noro 1: /* $OpenXM: OpenXM/src/asir99/io/cio.c,v 1.2 1999/11/18 02:24:01 noro Exp $ */
2: #include "ca.h"
3: #include "parse.h"
4: #include "ox.h"
5:
6: #define ISIZ sizeof(int)
7:
8: int write_cmo_zz(FILE *,int,N);
9: int read_cmo_zz(FILE *,int *,N *);
10:
11: int valid_as_cmo(obj)
12: Obj obj;
13: {
14: NODE m;
15:
16: if ( !obj )
17: return 1;
18: switch ( OID(obj) ) {
19: case O_MATHCAP: case O_P: case O_R: case O_DP: case O_STR:
20: case O_ERR: case O_USINT: case O_VOID:
21: return 1;
22: case O_N:
23: if ( NID((Num)obj) == N_Q )
24: return 1;
25: else
26: return 0;
27: case O_LIST:
28: for ( m = BDY((LIST)obj); m; m = NEXT(m) )
29: if ( !valid_as_cmo(BDY(m)) )
30: return 0;
31: return 1;
32: default:
33: return 0;
34: }
35: }
36:
37: write_cmo(s,obj)
38: FILE *s;
39: Obj obj;
40: {
41: int r;
42: char errmsg[BUFSIZ];
43:
44: if ( !obj ) {
45: r = CMO_NULL; write_int(s,&r);
46: return;
47: }
48: switch ( OID(obj) ) {
49: case O_N:
50: write_cmo_q(s,obj);
51: break;
52: case O_P:
53: write_cmo_p(s,obj);
54: break;
55: case O_R:
56: write_cmo_r(s,obj);
57: break;
58: case O_DP:
59: write_cmo_dp(s,obj);
60: break;
61: case O_LIST:
62: write_cmo_list(s,obj);
63: break;
64: case O_STR:
65: write_cmo_string(s,obj);
66: break;
67: case O_USINT:
68: write_cmo_uint(s,obj);
69: break;
70: case O_MATHCAP:
71: write_cmo_mathcap(s,obj);
72: break;
73: case O_ERR:
74: write_cmo_error(s,obj);
75: break;
76: case O_VOID:
77: r = ((USINT)obj)->body; write_int(s,&r);
78: break;
79: default:
80: sprintf(errmsg, "write_cmo : id=%d not implemented.",OID(obj));
81: error(errmsg);
82: break;
83: }
84: }
85:
86: write_cmo_mathcap(s,mc)
87: FILE *s;
88: MATHCAP mc;
89: {
90: unsigned int r;
91:
92: r = CMO_MATHCAP; write_int(s,&r);
93: write_cmo(s,BDY(mc));
94: }
95:
96: write_cmo_uint(s,ui)
97: FILE *s;
98: USINT ui;
99: {
100: unsigned int r;
101:
102: r = CMO_INT32; write_int(s,&r);
103: r = ui->body; write_int(s,&r);
104: }
105:
106: write_cmo_q(s,q)
107: FILE *s;
108: Q q;
109: {
110: int r;
111:
112: if ( q && DN(q) ) {
113: r = CMO_QQ; write_int(s,&r);
114: write_cmo_zz(s,SGN(q),NM(q));
115: write_cmo_zz(s,1,DN(q));
116: } else {
117: r = CMO_ZZ; write_int(s,&r);
118: write_cmo_zz(s,SGN(q),NM(q));
119: }
120: }
121:
122: write_cmo_zz(s,sgn,n)
123: FILE *s;
124: int sgn;
125: N n;
126: {
127: int i,l,bytes;
128: unsigned int t;
129: unsigned int *b;
130: unsigned char c;
131:
132: #if 1
133: l = PL(n);
134: bytes = sgn*l;
135: write_int(s,&bytes);
136: write_intarray(s,BD(n),l);
137: #else
138: l = PL(n); b = (unsigned int *)BD(n);
139: bytes = sgn*4*l;
140: write_int(s,&bytes);
141: for ( i = l-1; i >= 0; i-- ) {
142: t = b[i];
143: c = t>>24; write_char(s,&c);
144: c = (t>>16)&0xff; write_char(s,&c);
145: c = (t>>8)&0xff; write_char(s,&c);
146: c = t&0xff; write_char(s,&c);
147: }
148: #endif
149: }
150:
151: write_cmo_p(s,p)
152: FILE *s;
153: P p;
154: {
155: int r,i;
156: VL t,vl;
157: char *namestr;
158: STRING name;
159: NODE n0,n;
160:
161: r = CMO_RECURSIVE_POLYNOMIAL; write_int(s,&r);
162: get_vars((Obj)p,&vl);
163:
164: /* indeterminate list */
165: r = CMO_LIST; write_int(s,&r);
166: for ( t = vl, i = 0; t; t = NEXT(t), i++ );
167: write_int(s,&i);
168: r = CMO_INDETERMINATE;
169: for ( t = vl; t; t = NEXT(t) ) {
170: write_int(s,&r);
171: /* localname_to_cmoname(NAME(t->v),&namestr); */
172: namestr = NAME(t->v);
173: MKSTR(name,namestr);
174: write_cmo(s,name);
175: }
176:
177: /* body */
178: write_cmo_upoly(s,vl,p);
179: }
180:
181: write_cmo_upoly(s,vl,p)
182: FILE *s;
183: VL vl;
184: P p;
185: {
186: int r,i;
187: V v;
188: DCP dc,dct;
189: VL vlt;
190:
191: if ( NUM(p) )
192: write_cmo(s,p);
193: else {
194: r = CMO_UNIVARIATE_POLYNOMIAL; write_int(s,&r);
195: v = VR(p);
196: dc = DC(p);
197: for ( i = 0, dct = dc; dct; dct = NEXT(dct), i++ );
198: write_int(s,&i);
199: for ( i = 0, vlt = vl; vlt->v != v; vlt = NEXT(vlt), i++ );
200: write_int(s,&i);
201: for ( dct = dc; dct; dct = NEXT(dct) ) {
202: i = QTOS(DEG(dct)); write_int(s,&i);
203: write_cmo_upoly(s,vl,COEF(dct));
204: }
205: }
206: }
207:
208: write_cmo_r(s,f)
209: FILE *s;
210: R f;
211: {
212: int r;
213:
214: r = CMO_RATIONAL; write_int(s,&r);
215: write_cmo(s,NM(f));
216: write_cmo(s,DN(f));
217: }
218:
219: write_cmo_dp(s,dp)
220: FILE *s;
221: DP dp;
222: {
223: int i,n,nv,r;
224: MP m;
225:
226: for ( n = 0, m = BDY(dp); m; m = NEXT(m), n++ );
227: r = CMO_DISTRIBUTED_POLYNOMIAL; write_int(s,&r);
228: r = n; write_int(s,&r);
229: r = CMO_DMS_GENERIC; write_int(s,&r);
230: nv = dp->nv;
231: for ( i = 0, m = BDY(dp); i < n; i++, m = NEXT(m) )
232: write_cmo_monomial(s,m,nv);
233: }
234:
235: write_cmo_monomial(s,m,n)
236: FILE *s;
237: MP m;
238: int n;
239: {
240: int i,r;
241: int *p;
242:
243: r = CMO_MONOMIAL32; write_int(s,&r);
244: write_int(s,&n);
245: for ( i = 0, p = m->dl->d; i < n; i++ ) {
246: write_int(s,p++);
247: }
248: write_cmo_q(s,m->c);
249: }
250:
251: write_cmo_list(s,list)
252: FILE *s;
253: LIST list;
254: {
255: NODE m;
256: int i,n,r;
257:
258: for ( n = 0, m = BDY(list); m; m = NEXT(m), n++ );
259: r = CMO_LIST; write_int(s,&r);
260: write_int(s,&n);
261: for ( i = 0, m = BDY(list); i < n; i++, m = NEXT(m) )
262: write_cmo(s,BDY(m));
263: }
264:
265: write_cmo_string(s,str)
266: FILE *s;
267: STRING str;
268: {
269: int r;
270:
271: r = CMO_STRING; write_int(s,&r);
272: savestr(s,BDY(str));
273: }
274:
275: write_cmo_error(s,e)
276: FILE *s;
277: ERR e;
278: {
279: int r;
280:
281: r = CMO_ERROR2; write_int(s,&r);
282: write_cmo(s,BDY(e));
283: }
284:
285: read_cmo(s,rp)
286: FILE *s;
287: Obj *rp;
288: {
289: int id;
290: int n,sgn,dummy;
291: Q q,qnm,qdn;
292: N nm,dn;
293: P p,pnm,pdn;
294: R r;
295: STRING str;
296: USINT t;
297: DP dp;
298: char *b;
299: Obj obj;
300: ERR e;
301: MATHCAP mc;
302:
303: read_int(s,&id);
304: switch ( id ) {
305: /* level 0 objects */
306: case CMO_NULL:
307: *rp = 0;
308: break;
309: case CMO_INT32:
310: read_cmo_uint(s,rp);
311: break;
312: case CMO_DATUM:
313: case CMO_STRING:
314: loadstring(s,&str); *rp = (Obj)str;
315: break;
316: case CMO_MATHCAP:
317: read_cmo(s,&obj); MKMATHCAP(mc,(LIST)obj);
318: *rp = (Obj)mc;
319: break;
320: case CMO_ERROR:
321: MKERR(e,0); *rp = (Obj)e;
322: break;
323: case CMO_ERROR2:
324: read_cmo(s,&obj); MKERR(e,obj); *rp = (Obj)e;
325: break;
326: /* level 1 objects */
327: case CMO_LIST:
328: read_cmo_list(s,rp);
329: break;
330: case CMO_MONOMIAL32:
331: read_cmo_monomial(s,rp);
332: break;
333: case CMO_ZZ:
334: read_cmo_zz(s,&sgn,&nm);
335: NTOQ(nm,sgn,q); *rp = (Obj)q;
336: break;
337: case CMO_QQ:
338: read_cmo_zz(s,&sgn,&nm);
339: read_cmo_zz(s,&dummy,&dn);
340: NDTOQ(nm,dn,sgn,q); *rp = (Obj)q;
341: break;
342: case CMO_DISTRIBUTED_POLYNOMIAL:
343: read_cmo_dp(s,&dp); *rp = (Obj)dp;
344: break;
345: case CMO_RECURSIVE_POLYNOMIAL:
346: read_cmo_p(s,&p); *rp = (Obj)p;
347: break;
348: case CMO_UNIVARIATE_POLYNOMIAL:
349: read_cmo_upoly(s,&p); *rp = (Obj)p;
350: break;
351: case CMO_INDETERMINATE:
352: read_cmo(s,&str); *rp = (Obj)str;
353: break;
354: case CMO_RATIONAL:
355: read_cmo(s,&pnm); read_cmo(s,&pdn);
356: divr(CO,(Obj)pnm,(Obj)pdn,rp);
357: break;
358: case CMO_ZERO:
359: *rp = 0;
360: break;
361: case CMO_DMS_OF_N_VARIABLES:
362: read_cmo(s,rp);
363: break;
364: case CMO_RING_BY_NAME:
365: read_cmo(s,rp);
366: break;
367: default:
368: MKUSINT(t,id);
369: t->id = O_VOID;
370: *rp = (Obj)t;
371: break;
372: }
373: }
374:
375: read_cmo_uint(s,rp)
376: FILE *s;
377: USINT *rp;
378: {
379: unsigned int body;
380:
381: read_int(s,&body);
382: MKUSINT(*rp,body);
383: }
384:
385: read_cmo_zz(s,sgn,rp)
386: FILE *s;
387: int *sgn;
388: N *rp;
389: {
390: int l,i,words;
391: N n;
392: unsigned int *b;
393: unsigned int h;
394: unsigned char c;
395:
396: read_int(s,&l);
397: if ( l == 0 ) {
398: *sgn = 0;
399: *rp = 0;
400: return;
401: }
402: if ( l < 0 ) {
403: *sgn = -1; l = -l;
404: } else
405: *sgn = 1;
406: #if 1
407: *rp = n = NALLOC(l); PL(n) = l;
408: read_intarray(s,BD(n),l);
409: #else
410: words = (l+3)/4;
411: *rp = n = NALLOC(words); PL(n) = words; b = BD(n);
412: h = 0;
413: switch ( l % 4 ) {
414: case 0:
415: read_char(s,&c); h = c;
416: case 3:
417: read_char(s,&c); h = (h<<8)|c;
418: case 2:
419: read_char(s,&c); h = (h<<8)|c;
420: case 1:
421: read_char(s,&c); h = (h<<8)|c;
422: }
423: b[words-1] = h;
424: for ( i = words-2; i >= 0; i-- ) {
425: read_char(s,&c); h = c;
426: read_char(s,&c); h = (h<<8)|c;
427: read_char(s,&c); h = (h<<8)|c;
428: read_char(s,&c); h = (h<<8)|c;
429: b[i] = h;
430: }
431: #endif
432: }
433:
434: read_cmo_list(s,rp)
435: FILE *s;
436: Obj *rp;
437: {
438: int len;
439: Obj *w;
440: int i;
441: Obj r,r1;
442: NODE n0,n1;
443: LIST list;
444:
445: read_int(s,&len);
446: w = (Obj *)ALLOCA(len*sizeof(Obj));
447: for ( i = 0; i < len; i++ )
448: read_cmo(s,&w[i]);
449: for ( i = len-1, n0 = 0; i >= 0; i-- ) {
450: MKNODE(n1,w[i],n0); n0 = n1;
451: }
452: MKLIST(list,n0);
453: *rp = (Obj)list;
454: }
455:
456: read_cmo_dp(s,rp)
457: FILE *s;
458: DP *rp;
459: {
460: int len;
461: int i;
462: NODE n0,n1;
463: MP mp0,mp;
464: int nv,d;
465: DP dp;
466: Obj obj;
467:
468: read_int(s,&len);
469: /* skip the ring definition */
470: read_cmo(s,&obj);
471: for ( mp0 = 0, i = 0, d = 0; i < len; i++ ) {
472: read_cmo(s,&dp);
473: if ( !mp0 ) {
474: nv = dp->nv;
475: mp0 = dp->body;
476: mp = mp0;
477: } else {
478: NEXT(mp) = dp->body;
479: mp = NEXT(mp);
480: }
481: d = MAX(d,dp->sugar);
482: }
483: MKDP(nv,mp0,dp);
484: dp->sugar = d; *rp = dp;
485: }
486:
487: read_cmo_monomial(s,rp)
488: FILE *s;
489: DP *rp;
490: {
491: MP m;
492: DP dp;
493: int i,sugar,n;
494: DL dl;
495:
496: read_int(s,&n);
497: NEWMP(m); NEWDL(dl,n); m->dl = dl;
498: read_intarray(s,dl->d,n);
499: for ( sugar = 0, i = 0; i < n; i++ )
500: sugar += dl->d[i];
501: dl->td = sugar;
502: read_cmo(s,&m->c);
503: NEXT(m) = 0; MKDP(n,m,dp); dp->sugar = sugar; *rp = dp;
504: }
505:
506: static V *remote_vtab;
507:
508: read_cmo_p(s,rp)
509: FILE *s;
510: P *rp;
511: {
512: LIST vlist;
513: int nv,i;
514: V *vtab;
515: V v1,v2;
516: NODE t;
517: P v,p;
518: VL tvl,rvl;
519: char *name;
520:
521: read_cmo(s,&vlist);
522: nv = length(BDY(vlist));
523: vtab = (V *)ALLOCA(nv*sizeof(V));
524: for ( i = 0, t = BDY(vlist); i < nv; t = NEXT(t), i++ ) {
525: /* cmoname_to_localname(BDY((STRING)BDY(t)),&name); */
526: name = BDY((STRING)BDY(t));
527: makevar(name,&v); vtab[i] = VR(v);
528: }
529: remote_vtab = vtab;
530: read_cmo(s,&p);
531: for ( i = 0; i < nv-1; i++ ) {
532: v1 = vtab[i]; v2 = vtab[i+1];
533: for ( tvl = CO; tvl->v != v1 && tvl->v != v2; tvl = NEXT(tvl) );
534: if ( tvl->v == v2 )
535: break;
536: }
537: if ( i < nv-1 ) {
538: for ( i = nv-1, rvl = 0; i >= 0; i-- ) {
539: NEWVL(tvl); tvl->v = vtab[i]; NEXT(tvl) = rvl; rvl = tvl;
540: }
541: reorderp(CO,rvl,p,rp);
542: } else
543: *rp = p;
544: }
545:
546: read_cmo_upoly(s,rp)
547: FILE *s;
548: P *rp;
549: {
550: int n,ind,i,d;
551: P c;
552: Q q;
553: DCP dc0,dc;
554:
555: read_int(s,&n);
556: read_int(s,&ind);
557: for ( i = 0, dc0 = 0; i < n; i++ ) {
558: read_int(s,&d);
559: read_cmo(s,&c);
560: if ( c ) {
561: if ( OID(c) == O_USINT ) {
562: UTOQ(((USINT)c)->body,q); c = (P)q;
563: }
564: NEXTDC(dc0,dc);
565: STOQ(d,q);
566: dc->c = c; dc->d = q;
567: }
568: }
569: if ( dc0 )
570: NEXT(dc) = 0;
571: MKP(remote_vtab[ind],dc0,*rp);
572: }
573:
574: localname_to_cmoname(a,b)
575: char *a;
576: char **b;
577: {
578: int l;
579: char *t;
580:
581: l = strlen(a);
582: if ( l >= 2 && a[0] == '@' && isupper(a[1]) ) {
583: t = *b = (char *)MALLOC_ATOMIC(l);
584: strcpy(t,a+1);
585: } else {
586: t = *b = (char *)MALLOC_ATOMIC(l+1);
587: strcpy(t,a);
588: }
589: }
590:
591: cmoname_to_localname(a,b)
592: char *a;
593: char **b;
594: {
595: int l;
596: char *t;
597:
598: l = strlen(a);
599: if ( isupper(a[0]) ) {
600: t = *b = (char *)MALLOC_ATOMIC(l+2);
601: strcpy(t+1,a);
602: t[0] = '@';
603: } else {
604: t = *b = (char *)MALLOC_ATOMIC(l+1);
605: strcpy(t,a);
606: }
607: }