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