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