![[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.7 ! noro 47: * $OpenXM: OpenXM_contrib2/asir2000/io/cio.c,v 1.6 2000/11/08 08:02:51 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:
1.6 noro 67: case O_ERR: case O_USINT: case O_BYTEARRAY: case O_VOID:
1.1 noro 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;
1.7 ! noro 79: case O_QUOTE:
! 80: return 1;
1.1 noro 81: default:
82: return 0;
83: }
84: }
85:
86: write_cmo(s,obj)
87: FILE *s;
88: Obj obj;
89: {
90: int r;
91: char errmsg[BUFSIZ];
92:
93: if ( !obj ) {
94: r = CMO_NULL; write_int(s,&r);
95: return;
96: }
97: switch ( OID(obj) ) {
98: case O_N:
1.2 noro 99: switch ( NID((Num)obj) ) {
100: case N_Q:
101: write_cmo_q(s,(Q)obj);
102: break;
103: case N_R:
104: write_cmo_real(s,(Real)obj);
105: break;
106: default:
107: sprintf(errmsg, "write_cmo : number id=%d not implemented.",
108: NID((Num)obj));
109: error(errmsg);
110: break;
111: }
1.1 noro 112: break;
113: case O_P:
114: write_cmo_p(s,obj);
115: break;
116: case O_R:
117: write_cmo_r(s,obj);
118: break;
119: case O_DP:
120: write_cmo_dp(s,obj);
121: break;
122: case O_LIST:
123: write_cmo_list(s,obj);
124: break;
125: case O_STR:
126: write_cmo_string(s,obj);
127: break;
128: case O_USINT:
129: write_cmo_uint(s,obj);
130: break;
131: case O_MATHCAP:
132: write_cmo_mathcap(s,obj);
133: break;
134: case O_ERR:
135: write_cmo_error(s,obj);
136: break;
1.6 noro 137: case O_BYTEARRAY:
138: write_cmo_bytearray(s,obj);
139: break;
1.1 noro 140: case O_VOID:
141: r = ((USINT)obj)->body; write_int(s,&r);
142: break;
1.7 ! noro 143: case O_QUOTE:
! 144: write_cmo_tree(s,(FNODE)(((QUOTE)obj)->body));
! 145: break;
1.1 noro 146: default:
147: sprintf(errmsg, "write_cmo : id=%d not implemented.",OID(obj));
148: error(errmsg);
149: break;
150: }
1.5 noro 151: }
152:
153: int cmo_tag(obj,tag)
154: Obj obj;
155: int *tag;
156: {
157: if ( !valid_as_cmo(obj) )
158: return 0;
159: if ( !obj ) {
160: *tag = CMO_NULL;
161: return 1;
162: }
163: switch ( OID(obj) ) {
164: case O_N:
165: switch ( NID((Num)obj) ) {
166: case N_Q:
167: *tag = DN((Q)obj) ? CMO_QQ : CMO_ZZ; break;
168: case N_R:
169: *tag = CMO_IEEE_DOUBLE_FLOAT; break;
170: default:
171: return 0;
172: }
173: break;
174: case O_P:
175: *tag = CMO_RECURSIVE_POLYNOMIAL; break;
176: case O_R:
177: *tag = CMO_RATIONAL; break;
178: case O_DP:
179: *tag = CMO_DISTRIBUTED_POLYNOMIAL; break;
180: case O_LIST:
181: *tag = CMO_LIST; break;
182: case O_STR:
183: *tag = CMO_STRING; break;
184: case O_USINT:
185: *tag = CMO_INT32; break;
186: case O_MATHCAP:
187: *tag = CMO_MATHCAP; break;
188: case O_ERR:
189: *tag = CMO_ERROR2; break;
1.7 ! noro 190: case O_QUOTE:
! 191: *tag = CMO_TREE; break; break;
1.5 noro 192: default:
193: return 0;
194: }
195: return 1;
1.1 noro 196: }
197:
198: write_cmo_mathcap(s,mc)
199: FILE *s;
200: MATHCAP mc;
201: {
202: unsigned int r;
203:
204: r = CMO_MATHCAP; write_int(s,&r);
205: write_cmo(s,BDY(mc));
206: }
207:
208: write_cmo_uint(s,ui)
209: FILE *s;
210: USINT ui;
211: {
212: unsigned int r;
213:
214: r = CMO_INT32; write_int(s,&r);
215: r = ui->body; write_int(s,&r);
216: }
217:
218: write_cmo_q(s,q)
219: FILE *s;
220: Q q;
221: {
222: int r;
223:
224: if ( q && DN(q) ) {
225: r = CMO_QQ; write_int(s,&r);
226: write_cmo_zz(s,SGN(q),NM(q));
227: write_cmo_zz(s,1,DN(q));
228: } else {
229: r = CMO_ZZ; write_int(s,&r);
230: write_cmo_zz(s,SGN(q),NM(q));
231: }
232: }
233:
1.2 noro 234: write_cmo_real(s,real)
235: FILE *s;
236: Real real;
237: {
238: unsigned int r;
239: double dbl;
240:
241: r = CMO_IEEE_DOUBLE_FLOAT; write_int(s,&r);
242: dbl = real->body; write_double(s,&dbl);
243: }
244:
1.1 noro 245: write_cmo_zz(s,sgn,n)
246: FILE *s;
247: int sgn;
248: N n;
249: {
250: int i,l,bytes;
251: unsigned int t;
252: unsigned int *b;
253: unsigned char c;
254:
255: #if 1
256: l = PL(n);
257: bytes = sgn*l;
258: write_int(s,&bytes);
259: write_intarray(s,BD(n),l);
260: #else
261: l = PL(n); b = (unsigned int *)BD(n);
262: bytes = sgn*4*l;
263: write_int(s,&bytes);
264: for ( i = l-1; i >= 0; i-- ) {
265: t = b[i];
266: c = t>>24; write_char(s,&c);
267: c = (t>>16)&0xff; write_char(s,&c);
268: c = (t>>8)&0xff; write_char(s,&c);
269: c = t&0xff; write_char(s,&c);
270: }
271: #endif
272: }
273:
274: write_cmo_p(s,p)
275: FILE *s;
276: P p;
277: {
278: int r,i;
279: VL t,vl;
280: char *namestr;
281: STRING name;
282: NODE n0,n;
283:
284: r = CMO_RECURSIVE_POLYNOMIAL; write_int(s,&r);
285: get_vars((Obj)p,&vl);
286:
287: /* indeterminate list */
288: r = CMO_LIST; write_int(s,&r);
289: for ( t = vl, i = 0; t; t = NEXT(t), i++ );
290: write_int(s,&i);
291: r = CMO_INDETERMINATE;
292: for ( t = vl; t; t = NEXT(t) ) {
293: write_int(s,&r);
294: /* localname_to_cmoname(NAME(t->v),&namestr); */
295: namestr = NAME(t->v);
296: MKSTR(name,namestr);
297: write_cmo(s,name);
298: }
299:
300: /* body */
301: write_cmo_upoly(s,vl,p);
302: }
303:
304: write_cmo_upoly(s,vl,p)
305: FILE *s;
306: VL vl;
307: P p;
308: {
309: int r,i;
310: V v;
311: DCP dc,dct;
312: VL vlt;
313:
314: if ( NUM(p) )
315: write_cmo(s,p);
316: else {
317: r = CMO_UNIVARIATE_POLYNOMIAL; write_int(s,&r);
318: v = VR(p);
319: dc = DC(p);
320: for ( i = 0, dct = dc; dct; dct = NEXT(dct), i++ );
321: write_int(s,&i);
322: for ( i = 0, vlt = vl; vlt->v != v; vlt = NEXT(vlt), i++ );
323: write_int(s,&i);
324: for ( dct = dc; dct; dct = NEXT(dct) ) {
325: i = QTOS(DEG(dct)); write_int(s,&i);
326: write_cmo_upoly(s,vl,COEF(dct));
327: }
328: }
329: }
330:
331: write_cmo_r(s,f)
332: FILE *s;
333: R f;
334: {
335: int r;
336:
337: r = CMO_RATIONAL; write_int(s,&r);
338: write_cmo(s,NM(f));
339: write_cmo(s,DN(f));
340: }
341:
342: write_cmo_dp(s,dp)
343: FILE *s;
344: DP dp;
345: {
346: int i,n,nv,r;
347: MP m;
348:
349: for ( n = 0, m = BDY(dp); m; m = NEXT(m), n++ );
350: r = CMO_DISTRIBUTED_POLYNOMIAL; write_int(s,&r);
351: r = n; write_int(s,&r);
352: r = CMO_DMS_GENERIC; write_int(s,&r);
353: nv = dp->nv;
354: for ( i = 0, m = BDY(dp); i < n; i++, m = NEXT(m) )
355: write_cmo_monomial(s,m,nv);
356: }
357:
358: write_cmo_monomial(s,m,n)
359: FILE *s;
360: MP m;
361: int n;
362: {
363: int i,r;
364: int *p;
365:
366: r = CMO_MONOMIAL32; write_int(s,&r);
367: write_int(s,&n);
368: for ( i = 0, p = m->dl->d; i < n; i++ ) {
369: write_int(s,p++);
370: }
371: write_cmo_q(s,m->c);
372: }
373:
374: write_cmo_list(s,list)
375: FILE *s;
376: LIST list;
377: {
378: NODE m;
379: int i,n,r;
380:
381: for ( n = 0, m = BDY(list); m; m = NEXT(m), n++ );
382: r = CMO_LIST; write_int(s,&r);
383: write_int(s,&n);
384: for ( i = 0, m = BDY(list); i < n; i++, m = NEXT(m) )
385: write_cmo(s,BDY(m));
386: }
387:
388: write_cmo_string(s,str)
389: FILE *s;
390: STRING str;
391: {
392: int r;
393:
394: r = CMO_STRING; write_int(s,&r);
395: savestr(s,BDY(str));
396: }
397:
1.6 noro 398: write_cmo_bytearray(s,array)
399: FILE *s;
400: BYTEARRAY array;
401: {
402: int r;
403:
404: r = CMO_DATUM; write_int(s,&r);
405: write_int(s,&array->len);
406: write_string(s,array->body,array->len);
407: }
408:
1.1 noro 409: write_cmo_error(s,e)
410: FILE *s;
411: ERR e;
412: {
413: int r;
414:
415: r = CMO_ERROR2; write_int(s,&r);
416: write_cmo(s,BDY(e));
417: }
418:
1.7 ! noro 419: /* XXX */
! 420:
! 421: write_cmo_tree(s,f)
! 422: FILE *s;
! 423: FNODE f;
! 424: {
! 425: int r,i,n;
! 426: char opname[BUFSIZ];
! 427: NODE args,t;
! 428: FUNC fspec;
! 429: struct oSTRING str,nullstr;
! 430:
! 431: /* null string */
! 432: nullstr.id = O_STR;
! 433: nullstr.body = 0;
! 434:
! 435: /* name string */
! 436: str.id = O_STR;
! 437: str.body = opname;
! 438:
! 439: switch ( f->id ) {
! 440: case I_BOP: case I_COP:
! 441: case I_AND: case I_OR:
! 442: /*
! 443: * (CMO_TREE (CMO_STRING,op),(CMO_STRING,0)(CMO_LIST,2,arg1,arg2))
! 444: */
! 445: switch ( f->id ) {
! 446: case I_BOP:
! 447: strcpy(opname,((ARF)FA0(f))->name); break;
! 448: case I_COP:
! 449: switch( (cid)FA0(f) ) {
! 450: case C_EQ: strcpy(opname,"=="); break;
! 451: case C_NE: strcpy(opname,"!="); break;
! 452: case C_GT: strcpy(opname,">"); break;
! 453: case C_LT: strcpy(opname,"<"); break;
! 454: case C_GE: strcpy(opname,">="); break;
! 455: case C_LE: strcpy(opname,"<="); break;
! 456: }
! 457: break;
! 458: case I_AND:
! 459: strcpy(opname,"&&"); break;
! 460: case I_OR:
! 461: strcpy(opname,"||"); break;
! 462: }
! 463: r = CMO_TREE; write_int(s,&r);
! 464: write_cmo_string(s,&str);
! 465: write_cmo_string(s,&nullstr);
! 466: r = CMO_LIST; write_int(s,&r);
! 467: n = 2; write_int(s,&n);
! 468: write_cmo_tree(s,(FNODE)FA1(f));
! 469: write_cmo_tree(s,(FNODE)FA2(f));
! 470: break;
! 471: break;
! 472: case I_NOT:
! 473: r = CMO_TREE; write_int(s,&r);
! 474: strcpy(opname,"!");
! 475: write_cmo_string(s,&str);;
! 476: write_cmo_string(s,&nullstr);
! 477: r = CMO_LIST; write_int(s,&r);
! 478: n = 1; write_int(s,&n);
! 479: write_cmo_tree(s,(FNODE)FA1(f));
! 480: break;
! 481: case I_FUNC:
! 482: fspec = (FUNC)FA0(f);
! 483: strcpy(opname,fspec->name);
! 484: write_cmo_string(s,&str);
! 485: write_cmo_string(s,&nullstr);
! 486: args = (NODE)FA0((FNODE)FA1(f));
! 487: r = CMO_LIST; write_int(s,&r);
! 488: for ( n = 0, t = args; t; t = NEXT(t), n++ );
! 489: write_int(s,&n);
! 490: for ( i = 0, t = args; i < n; t = NEXT(t), i++ )
! 491: write_cmo_tree(s,BDY(t));
! 492: break;
! 493: case I_FORMULA:
! 494: write_cmo(s,FA0(f));
! 495: break;
! 496: default:
! 497: break; /* XXX */
! 498: }
! 499: }
! 500:
1.1 noro 501: read_cmo(s,rp)
502: FILE *s;
503: Obj *rp;
504: {
505: int id;
506: int n,sgn,dummy;
507: Q q,qnm,qdn;
508: N nm,dn;
509: P p,pnm,pdn;
510: R r;
1.2 noro 511: Real real;
512: double dbl;
1.1 noro 513: STRING str;
514: USINT t;
515: DP dp;
516: char *b;
517: Obj obj;
518: ERR e;
519: MATHCAP mc;
1.6 noro 520: BYTEARRAY array;
1.1 noro 521:
522: read_int(s,&id);
523: switch ( id ) {
524: /* level 0 objects */
525: case CMO_NULL:
526: *rp = 0;
527: break;
528: case CMO_INT32:
529: read_cmo_uint(s,rp);
530: break;
531: case CMO_DATUM:
1.6 noro 532: loadbytearray(s,&array); *rp = (Obj)array;
533: break;
1.1 noro 534: case CMO_STRING:
535: loadstring(s,&str); *rp = (Obj)str;
536: break;
537: case CMO_MATHCAP:
538: read_cmo(s,&obj); MKMATHCAP(mc,(LIST)obj);
539: *rp = (Obj)mc;
540: break;
541: case CMO_ERROR:
542: MKERR(e,0); *rp = (Obj)e;
543: break;
544: case CMO_ERROR2:
545: read_cmo(s,&obj); MKERR(e,obj); *rp = (Obj)e;
546: break;
547: /* level 1 objects */
548: case CMO_LIST:
549: read_cmo_list(s,rp);
550: break;
551: case CMO_MONOMIAL32:
552: read_cmo_monomial(s,rp);
553: break;
554: case CMO_ZZ:
555: read_cmo_zz(s,&sgn,&nm);
556: NTOQ(nm,sgn,q); *rp = (Obj)q;
557: break;
558: case CMO_QQ:
559: read_cmo_zz(s,&sgn,&nm);
560: read_cmo_zz(s,&dummy,&dn);
561: NDTOQ(nm,dn,sgn,q); *rp = (Obj)q;
1.2 noro 562: break;
563: case CMO_IEEE_DOUBLE_FLOAT:
564: read_double(s,&dbl); MKReal(dbl,real); *rp = (Obj)real;
1.1 noro 565: break;
566: case CMO_DISTRIBUTED_POLYNOMIAL:
567: read_cmo_dp(s,&dp); *rp = (Obj)dp;
568: break;
569: case CMO_RECURSIVE_POLYNOMIAL:
570: read_cmo_p(s,&p); *rp = (Obj)p;
571: break;
572: case CMO_UNIVARIATE_POLYNOMIAL:
573: read_cmo_upoly(s,&p); *rp = (Obj)p;
574: break;
575: case CMO_INDETERMINATE:
576: read_cmo(s,&str); *rp = (Obj)str;
577: break;
578: case CMO_RATIONAL:
579: read_cmo(s,&pnm); read_cmo(s,&pdn);
580: divr(CO,(Obj)pnm,(Obj)pdn,rp);
581: break;
582: case CMO_ZERO:
583: *rp = 0;
584: break;
585: case CMO_DMS_OF_N_VARIABLES:
586: read_cmo(s,rp);
587: break;
588: case CMO_RING_BY_NAME:
589: read_cmo(s,rp);
590: break;
1.7 ! noro 591: case CMO_TREE:
! 592: read_cmo_tree(s,rp);
! 593: break;
1.1 noro 594: default:
595: MKUSINT(t,id);
596: t->id = O_VOID;
597: *rp = (Obj)t;
598: break;
599: }
600: }
601:
602: read_cmo_uint(s,rp)
603: FILE *s;
604: USINT *rp;
605: {
606: unsigned int body;
607:
608: read_int(s,&body);
609: MKUSINT(*rp,body);
610: }
611:
612: read_cmo_zz(s,sgn,rp)
613: FILE *s;
614: int *sgn;
615: N *rp;
616: {
617: int l,i,words;
618: N n;
619: unsigned int *b;
620: unsigned int h;
621: unsigned char c;
622:
623: read_int(s,&l);
624: if ( l == 0 ) {
625: *sgn = 0;
626: *rp = 0;
627: return;
628: }
629: if ( l < 0 ) {
630: *sgn = -1; l = -l;
631: } else
632: *sgn = 1;
633: #if 1
634: *rp = n = NALLOC(l); PL(n) = l;
635: read_intarray(s,BD(n),l);
636: #else
637: words = (l+3)/4;
638: *rp = n = NALLOC(words); PL(n) = words; b = BD(n);
639: h = 0;
640: switch ( l % 4 ) {
641: case 0:
642: read_char(s,&c); h = c;
643: case 3:
644: read_char(s,&c); h = (h<<8)|c;
645: case 2:
646: read_char(s,&c); h = (h<<8)|c;
647: case 1:
648: read_char(s,&c); h = (h<<8)|c;
649: }
650: b[words-1] = h;
651: for ( i = words-2; i >= 0; i-- ) {
652: read_char(s,&c); h = c;
653: read_char(s,&c); h = (h<<8)|c;
654: read_char(s,&c); h = (h<<8)|c;
655: read_char(s,&c); h = (h<<8)|c;
656: b[i] = h;
657: }
658: #endif
659: }
660:
661: read_cmo_list(s,rp)
662: FILE *s;
663: Obj *rp;
664: {
665: int len;
666: Obj *w;
667: int i;
668: Obj r,r1;
669: NODE n0,n1;
670: LIST list;
671:
672: read_int(s,&len);
673: w = (Obj *)ALLOCA(len*sizeof(Obj));
674: for ( i = 0; i < len; i++ )
675: read_cmo(s,&w[i]);
676: for ( i = len-1, n0 = 0; i >= 0; i-- ) {
677: MKNODE(n1,w[i],n0); n0 = n1;
678: }
679: MKLIST(list,n0);
680: *rp = (Obj)list;
681: }
682:
683: read_cmo_dp(s,rp)
684: FILE *s;
685: DP *rp;
686: {
687: int len;
688: int i;
689: NODE n0,n1;
690: MP mp0,mp;
691: int nv,d;
692: DP dp;
693: Obj obj;
694:
695: read_int(s,&len);
696: /* skip the ring definition */
697: read_cmo(s,&obj);
698: for ( mp0 = 0, i = 0, d = 0; i < len; i++ ) {
699: read_cmo(s,&dp);
700: if ( !mp0 ) {
701: nv = dp->nv;
702: mp0 = dp->body;
703: mp = mp0;
704: } else {
705: NEXT(mp) = dp->body;
706: mp = NEXT(mp);
707: }
708: d = MAX(d,dp->sugar);
709: }
710: MKDP(nv,mp0,dp);
711: dp->sugar = d; *rp = dp;
712: }
713:
714: read_cmo_monomial(s,rp)
715: FILE *s;
716: DP *rp;
717: {
718: MP m;
719: DP dp;
720: int i,sugar,n;
721: DL dl;
722:
723: read_int(s,&n);
724: NEWMP(m); NEWDL(dl,n); m->dl = dl;
725: read_intarray(s,dl->d,n);
726: for ( sugar = 0, i = 0; i < n; i++ )
727: sugar += dl->d[i];
728: dl->td = sugar;
729: read_cmo(s,&m->c);
730: NEXT(m) = 0; MKDP(n,m,dp); dp->sugar = sugar; *rp = dp;
731: }
732:
733: static V *remote_vtab;
734:
735: read_cmo_p(s,rp)
736: FILE *s;
737: P *rp;
738: {
739: LIST vlist;
740: int nv,i;
741: V *vtab;
742: V v1,v2;
743: NODE t;
744: P v,p;
745: VL tvl,rvl;
746: char *name;
747:
748: read_cmo(s,&vlist);
749: nv = length(BDY(vlist));
750: vtab = (V *)ALLOCA(nv*sizeof(V));
751: for ( i = 0, t = BDY(vlist); i < nv; t = NEXT(t), i++ ) {
752: /* cmoname_to_localname(BDY((STRING)BDY(t)),&name); */
753: name = BDY((STRING)BDY(t));
754: makevar(name,&v); vtab[i] = VR(v);
755: }
756: remote_vtab = vtab;
757: read_cmo(s,&p);
758: for ( i = 0; i < nv-1; i++ ) {
759: v1 = vtab[i]; v2 = vtab[i+1];
760: for ( tvl = CO; tvl->v != v1 && tvl->v != v2; tvl = NEXT(tvl) );
761: if ( tvl->v == v2 )
762: break;
763: }
764: if ( i < nv-1 ) {
765: for ( i = nv-1, rvl = 0; i >= 0; i-- ) {
766: NEWVL(tvl); tvl->v = vtab[i]; NEXT(tvl) = rvl; rvl = tvl;
767: }
768: reorderp(CO,rvl,p,rp);
769: } else
770: *rp = p;
771: }
772:
773: read_cmo_upoly(s,rp)
774: FILE *s;
775: P *rp;
776: {
777: int n,ind,i,d;
778: P c;
779: Q q;
780: DCP dc0,dc;
781:
782: read_int(s,&n);
783: read_int(s,&ind);
784: for ( i = 0, dc0 = 0; i < n; i++ ) {
785: read_int(s,&d);
786: read_cmo(s,&c);
787: if ( c ) {
788: if ( OID(c) == O_USINT ) {
789: UTOQ(((USINT)c)->body,q); c = (P)q;
790: }
791: NEXTDC(dc0,dc);
792: STOQ(d,q);
793: dc->c = c; dc->d = q;
794: }
795: }
796: if ( dc0 )
797: NEXT(dc) = 0;
798: MKP(remote_vtab[ind],dc0,*rp);
1.7 ! noro 799: }
! 800:
! 801: /* XXX */
! 802:
! 803: extern struct oARF arf[];
! 804:
! 805: struct operator_tab {
! 806: char *name;
! 807: fid id;
! 808: ARF arf;
! 809: cid cid;
! 810: };
! 811:
! 812: static struct operator_tab optab[] = {
! 813: {"+",I_BOP,&arf[0],0}, /* XXX */
! 814: {"-",I_BOP,&arf[1],0},
! 815: {"*",I_BOP,&arf[2],0},
! 816: {"/",I_BOP,&arf[3],0},
! 817: {"%",I_BOP,&arf[4],0},
! 818: {"^",I_BOP,&arf[5],0},
! 819: {"==",I_COP,0,C_EQ},
! 820: {"!=",I_COP,0,C_NE},
! 821: {"<",I_COP,0,C_LT},
! 822: {"<=",I_COP,0,C_LE},
! 823: {">",I_COP,0,C_GT},
! 824: {">=",I_COP,0,C_GE},
! 825: {"&&",I_AND,0,0},
! 826: {"||",I_OR,0,0},
! 827: {"!",I_NOT,0,0},
! 828: };
! 829:
! 830: static int optab_len = sizeof(optab)/sizeof(struct operator_tab);
! 831:
! 832: read_cmo_tree(s,rp)
! 833: FILE *s;
! 834: QUOTE *rp;
! 835: {
! 836: int r,i,n;
! 837: char *opname;
! 838: STRING name,cd;
! 839: int op;
! 840: LIST alist;
! 841: NODE arg;
! 842: QUOTE quote;
! 843: FNODE fn;
! 844: fid id;
! 845:
! 846: read_cmo(s,&name);
! 847: read_cmo(s,&cd); /* XXX: currently not used */
! 848: for ( i = 0; i < optab_len; i++ )
! 849: if ( !strcmp(optab[i].name,BDY(name)) )
! 850: break;
! 851: if ( i == optab_len ) {
! 852: /* may be a function name */
! 853: } else {
! 854: opname = optab[i].name;
! 855: id = optab[i].id;
! 856: switch ( id ) {
! 857: case I_BOP:
! 858: op = opname[0];
! 859: read_cmo(s,&alist);
! 860: arg = BDY(alist);
! 861: fn = mkfnode(3,I_BOP,optab[i].arf,ARG0(arg),ARG1(arg));
! 862: MKQUOTE(quote,fn);
! 863: break;
! 864: case I_COP:
! 865: read_cmo(s,&alist);
! 866: arg = BDY(alist);
! 867: fn = mkfnode(3,I_COP,optab[i].cid,ARG0(arg),ARG1(arg));
! 868: MKQUOTE(quote,fn);
! 869: break;
! 870: case I_AND:
! 871: read_cmo(s,&alist);
! 872: arg = BDY(alist);
! 873: fn = mkfnode(2,I_AND,ARG0(arg),ARG1(arg));
! 874: MKQUOTE(quote,fn);
! 875: break;
! 876: case I_OR:
! 877: read_cmo(s,&alist);
! 878: arg = BDY(alist);
! 879: fn = mkfnode(2,I_OR,ARG0(arg),ARG1(arg));
! 880: MKQUOTE(quote,fn);
! 881: break;
! 882: case I_NOT:
! 883: read_cmo(s,&alist);
! 884: arg = BDY(alist);
! 885: fn = mkfnode(1,I_OR,ARG0(arg));
! 886: MKQUOTE(quote,fn);
! 887: break;
! 888: }
! 889: *rp = quote;
! 890: }
1.1 noro 891: }
892:
893: localname_to_cmoname(a,b)
894: char *a;
895: char **b;
896: {
897: int l;
898: char *t;
899:
900: l = strlen(a);
901: if ( l >= 2 && a[0] == '@' && isupper(a[1]) ) {
902: t = *b = (char *)MALLOC_ATOMIC(l);
903: strcpy(t,a+1);
904: } else {
905: t = *b = (char *)MALLOC_ATOMIC(l+1);
906: strcpy(t,a);
907: }
908: }
909:
910: cmoname_to_localname(a,b)
911: char *a;
912: char **b;
913: {
914: int l;
915: char *t;
916:
917: l = strlen(a);
918: if ( isupper(a[0]) ) {
919: t = *b = (char *)MALLOC_ATOMIC(l+2);
920: strcpy(t+1,a);
921: t[0] = '@';
922: } else {
923: t = *b = (char *)MALLOC_ATOMIC(l+1);
924: strcpy(t,a);
925: }
926: }