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