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