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