Annotation of OpenXM_contrib2/asir2000/engine/C.c, Revision 1.15
1.2 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.3 noro 26: * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.2 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.
47: *
1.15 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/engine/C.c,v 1.14 2003/01/16 00:33:28 noro Exp $
1.2 noro 49: */
1.1 noro 50: #include "ca.h"
51: #include "inline.h"
52: #include "base.h"
53:
54: V up_var;
55:
56: /* binary has at least 32 leading 0 chars. */
1.11 noro 57: void binaryton(char *binary,N *np)
1.1 noro 58: {
1.15 ! noro 59: int i,w,len;
! 60: N n;
! 61: char buf[33];
! 62:
! 63: binary += strlen(binary)%32;
! 64: len = strlen(binary);
! 65: w = len/32; /* sufficient for holding binary */
! 66: n = NALLOC(w);
! 67: for ( i = 0; i < w; i++ ) {
! 68: strncpy(buf,binary+len-32*(i+1),32); buf[32] = 0;
! 69: n->b[i] = strtoul(buf,0,2);
! 70: }
! 71: for ( i = w-1; i >= 0 && !n->b[i]; i-- );
! 72: if ( i < 0 )
! 73: *np = 0;
! 74: else {
! 75: n->p = i+1;
! 76: *np = n;
! 77: }
1.1 noro 78: }
79:
80: /* hex has at least 8 leading 0 chars. */
1.11 noro 81: void hexton(char *hex,N *np)
1.1 noro 82: {
1.15 ! noro 83: int i,w,len;
! 84: N n;
! 85: char buf[9];
! 86:
! 87: hex += strlen(hex)%8;
! 88: len = strlen(hex);
! 89: w = len/8; /* sufficient for holding hex */
! 90: n = NALLOC(w);
! 91: for ( i = 0; i < w; i++ ) {
! 92: strncpy(buf,hex+len-8*(i+1),8); buf[8] = 0;
! 93: n->b[i] = strtoul(buf,0,16);
! 94: }
! 95: for ( i = w-1; i >= 0 && !n->b[i]; i-- );
! 96: if ( i < 0 )
! 97: *np = 0;
! 98: else {
! 99: n->p = i+1;
! 100: *np = n;
! 101: }
1.1 noro 102: }
103:
1.11 noro 104: void ntobn(int base,N n,N *nrp)
1.1 noro 105: {
1.15 ! noro 106: int i,d,plc;
! 107: unsigned int *c,*x,*w;
! 108: unsigned int r;
! 109: L m;
! 110: N nr;
! 111:
! 112: if ( !n ) {
! 113: *nrp = NULL;
! 114: return;
! 115: }
! 116:
! 117: d = PL(n);
! 118: w = BD(n);
! 119:
! 120: for ( i = 1, m = 1; m <= LBASE/(L)base; m *= base, i++ );
! 121:
! 122: c = (unsigned int *)W_ALLOC(d*i+1);
! 123: x = (unsigned int *)W_ALLOC(d+1);
! 124: for ( i = 0; i < d; i++ )
! 125: x[i] = w[i];
! 126: for ( plc = 0; d >= 1; plc++ ) {
! 127: for ( i = d - 1, r = 0; i >= 0; i-- ) {
! 128: DSAB((unsigned int)base,r,x[i],x[i],r)
! 129: }
! 130: c[plc] = r;
! 131: if ( !x[d-1] ) d--;
! 132: }
! 133:
! 134: *nrp = nr = NALLOC(plc); INITRC(nr);
! 135: PL(nr) = plc;
! 136: for ( i = 0; i < plc; i++ )
! 137: BD(nr)[i] = c[i];
1.1 noro 138: }
139:
1.11 noro 140: void bnton(int base,N n,N *nrp)
1.1 noro 141: {
1.15 ! noro 142: unsigned int carry;
! 143: unsigned int *x,*w;
! 144: int i,j,d,plc;
! 145: N nr;
! 146:
! 147: if ( !n ) {
! 148: *nrp = 0;
! 149: return;
! 150: }
! 151:
! 152: d = PL(n);
! 153: w = BD(n);
! 154: x = (unsigned int *)W_ALLOC(d + 1);
! 155:
! 156: for ( plc = 0, i = d - 1; i >= 0; i-- ) {
! 157: for ( carry = w[i],j = 0; j < plc; j++ ) {
! 158: DMA(x[j],(unsigned int)base,carry,carry,x[j])
! 159: }
! 160: if ( carry ) x[plc++] = carry;
! 161: }
! 162: *nrp = nr = NALLOC(plc); INITRC(nr);
! 163: PL(nr) = plc;
! 164: for ( i = 0; i < plc; i++ )
! 165: BD(nr)[i] = x[i];
1.1 noro 166: }
167:
1.11 noro 168: void ptomp(int m,P p,P *pr)
1.1 noro 169: {
1.15 ! noro 170: DCP dc,dcr,dcr0;
! 171: Q q;
! 172: unsigned int a,b;
! 173: P t;
! 174: MQ s;
! 175:
! 176: if ( !p )
! 177: *pr = 0;
! 178: else if ( NUM(p) ) {
! 179: q = (Q)p;
! 180: a = rem(NM(q),m);
! 181: if ( a && (SGN(q) < 0) )
! 182: a = m-a;
! 183: b = !DN(q)?1:rem(DN(q),m);
! 184: if ( !b )
! 185: error("ptomp : denominator = 0");
! 186: a = dmar(a,invm(b,m),0,m); STOMQ(a,s); *pr = (P)s;
! 187: } else {
! 188: for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
! 189: ptomp(m,COEF(dc),&t);
! 190: if ( t ) {
! 191: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
! 192: }
! 193: }
! 194: if ( !dcr0 )
! 195: *pr = 0;
! 196: else {
! 197: NEXT(dcr) = 0; MKP(VR(p),dcr0,*pr);
! 198: }
! 199: }
1.1 noro 200: }
1.15 ! noro 201:
1.11 noro 202: void mptop(P f,P *gp)
1.1 noro 203: {
1.15 ! noro 204: DCP dc,dcr,dcr0;
! 205: Q q;
1.1 noro 206:
1.15 ! noro 207: if ( !f )
! 208: *gp = 0;
! 209: else if ( NUM(f) )
! 210: STOQ(CONT((MQ)f),q),*gp = (P)q;
! 211: else {
! 212: for ( dc = DC(f), dcr0 = 0; dc; dc = NEXT(dc) ) {
! 213: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); mptop(COEF(dc),&COEF(dcr));
! 214: }
! 215: NEXT(dcr) = 0; MKP(VR(f),dcr0,*gp);
! 216: }
1.4 noro 217: }
218:
1.11 noro 219: void ptosfp(P p,P *pr)
1.7 noro 220: {
1.15 ! noro 221: DCP dc,dcr,dcr0;
! 222: GFS a;
! 223: P t;
! 224:
! 225: if ( !p )
! 226: *pr = 0;
! 227: else if ( NUM(p) ) {
! 228: if ( NID((Num)p) == N_GFS )
! 229: *pr = (P)p;
! 230: else {
! 231: qtogfs((Q)p,&a); *pr = (P)a;
! 232: }
! 233: } else {
! 234: for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
! 235: ptosfp(COEF(dc),&t);
! 236: if ( t ) {
! 237: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
! 238: }
! 239: }
! 240: if ( !dcr0 )
! 241: *pr = 0;
! 242: else {
! 243: NEXT(dcr) = 0; MKP(VR(p),dcr0,*pr);
! 244: }
! 245: }
1.7 noro 246: }
247:
1.11 noro 248: void sfptop(P f,P *gp)
1.4 noro 249: {
1.15 ! noro 250: DCP dc,dcr,dcr0;
! 251: Q q;
! 252: MQ fq;
! 253:
! 254: if ( !f )
! 255: *gp = 0;
! 256: else if ( NUM(f) ) {
! 257: gfstomq((GFS)f,&fq);
! 258: STOQ(CONT(fq),q);
! 259: *gp = (P)q;
! 260: } else {
! 261: for ( dc = DC(f), dcr0 = 0; dc; dc = NEXT(dc) ) {
! 262: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); sfptop(COEF(dc),&COEF(dcr));
! 263: }
! 264: NEXT(dcr) = 0; MKP(VR(f),dcr0,*gp);
! 265: }
1.14 noro 266: }
267:
268: void sfptopsfp(P f,V v,P *gp)
269: {
1.15 ! noro 270: DCP dc,dcr,dcr0;
! 271: Q q;
! 272: P fq;
! 273:
! 274: if ( !f )
! 275: *gp = 0;
! 276: else if ( NUM(f) )
! 277: gfstopgfs((GFS)f,v,gp);
! 278: else {
! 279: for ( dc = DC(f), dcr0 = 0; dc; dc = NEXT(dc) ) {
! 280: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc);
! 281: sfptopsfp(COEF(dc),v,&COEF(dcr));
! 282: }
! 283: NEXT(dcr) = 0; MKP(VR(f),dcr0,*gp);
! 284: }
1.7 noro 285: }
286:
1.11 noro 287: void sf_galois_action(P p,Q e,P *pr)
1.7 noro 288: {
1.15 ! noro 289: DCP dc,dcr,dcr0;
! 290: GFS a;
! 291: P t;
! 292:
! 293: if ( !p )
! 294: *pr = 0;
! 295: else if ( NUM(p) ) {
! 296: gfs_galois_action((GFS)p,e,&a); *pr = (P)a;
! 297: } else {
! 298: for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
! 299: sf_galois_action(COEF(dc),e,&t);
! 300: if ( t ) {
! 301: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
! 302: }
! 303: }
! 304: if ( !dcr0 )
! 305: *pr = 0;
! 306: else {
! 307: NEXT(dcr) = 0; MKP(VR(p),dcr0,*pr);
! 308: }
! 309: }
1.10 noro 310: }
311:
312: /* GF(pn)={0,1,a,a^2,...} -> GF(pm)={0,1,b,b^2,..} ; a -> b^k */
313:
1.11 noro 314: void sf_embed(P p,int k,int pm,P *pr)
1.10 noro 315: {
1.15 ! noro 316: DCP dc,dcr,dcr0;
! 317: GFS a;
! 318: P t;
! 319:
! 320: if ( !p )
! 321: *pr = 0;
! 322: else if ( NUM(p) ) {
! 323: gfs_embed((GFS)p,k,pm,&a); *pr = (P)a;
! 324: } else {
! 325: for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
! 326: sf_embed(COEF(dc),k,pm,&t);
! 327: if ( t ) {
! 328: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
! 329: }
! 330: }
! 331: if ( !dcr0 )
! 332: *pr = 0;
! 333: else {
! 334: NEXT(dcr) = 0; MKP(VR(p),dcr0,*pr);
! 335: }
! 336: }
1.1 noro 337: }
338:
1.11 noro 339: void ptolmp(P p,P *pr)
1.1 noro 340: {
1.15 ! noro 341: DCP dc,dcr,dcr0;
! 342: LM a;
! 343: P t;
! 344:
! 345: if ( !p )
! 346: *pr = 0;
! 347: else if ( NUM(p) ) {
! 348: qtolm((Q)p,&a); *pr = (P)a;
! 349: } else {
! 350: for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
! 351: ptolmp(COEF(dc),&t);
! 352: if ( t ) {
! 353: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
! 354: }
! 355: }
! 356: if ( !dcr0 )
! 357: *pr = 0;
! 358: else {
! 359: NEXT(dcr) = 0; MKP(VR(p),dcr0,*pr);
! 360: }
! 361: }
1.1 noro 362: }
1.15 ! noro 363:
1.11 noro 364: void lmptop(P f,P *gp)
1.1 noro 365: {
1.15 ! noro 366: DCP dc,dcr,dcr0;
! 367: Q q;
1.1 noro 368:
1.15 ! noro 369: if ( !f )
! 370: *gp = 0;
! 371: else if ( NUM(f) ) {
! 372: NTOQ(((LM)f)->body,1,q); *gp = (P)q;
! 373: } else {
! 374: for ( dc = DC(f), dcr0 = 0; dc; dc = NEXT(dc) ) {
! 375: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); lmptop(COEF(dc),&COEF(dcr));
! 376: }
! 377: NEXT(dcr) = 0; MKP(VR(f),dcr0,*gp);
! 378: }
1.1 noro 379: }
380:
1.11 noro 381: void ptoum(int m,P f,UM wf)
1.1 noro 382: {
1.15 ! noro 383: unsigned int r;
! 384: int i;
! 385: DCP dc;
! 386:
! 387: for ( i = UDEG(f); i >= 0; i-- )
! 388: COEF(wf)[i] = 0;
! 389:
! 390: for ( dc = DC(f); dc; dc = NEXT(dc) ) {
! 391: r = rem(NM((Q)COEF(dc)),m);
! 392: if ( r && (SGN((Q)COEF(dc)) < 0) )
! 393: r = m-r;
! 394: COEF(wf)[QTOS(DEG(dc))] = r;
! 395: }
! 396: degum(wf,UDEG(f));
1.1 noro 397: }
398:
1.11 noro 399: void umtop(V v,UM w,P *f)
1.1 noro 400: {
1.15 ! noro 401: int *c;
! 402: DCP dc,dc0;
! 403: int i;
! 404: Q q;
! 405:
! 406: if ( DEG(w) < 0 )
! 407: *f = 0;
! 408: else if ( DEG(w) == 0 )
! 409: STOQ(COEF(w)[0],q), *f = (P)q;
! 410: else {
! 411: for ( i = DEG(w), c = COEF(w), dc0 = 0; i >= 0; i-- )
! 412: if ( c[i] ) {
! 413: NEXTDC(dc0,dc);
! 414: STOQ(i,DEG(dc));
! 415: STOQ(c[i],q), COEF(dc) = (P)q;
! 416: }
! 417: NEXT(dc) = 0;
! 418: MKP(v,dc0,*f);
! 419: }
1.8 noro 420: }
421:
1.11 noro 422: void ptosfum(P f,UM wf)
1.8 noro 423: {
1.15 ! noro 424: GFS c;
! 425: int i;
! 426: DCP dc;
! 427:
! 428: if ( OID(f) == O_N ) {
! 429: DEG(wf) = 0;
! 430: ntogfs((Obj)f,&c);
! 431: COEF(wf)[0] = FTOIF(CONT(c));
! 432: return;
! 433: }
! 434:
! 435: for ( i = UDEG(f); i >= 0; i-- )
! 436: COEF(wf)[i] = 0;
! 437:
! 438: for ( dc = DC(f); dc; dc = NEXT(dc) ) {
! 439: ntogfs((Obj)COEF(dc),&c);
! 440: if ( c )
! 441: COEF(wf)[QTOS(DEG(dc))] = FTOIF(CONT(c));
! 442: }
! 443: degum(wf,UDEG(f));
1.8 noro 444: }
445:
1.11 noro 446: void sfumtop(V v,UM w,P *f)
1.8 noro 447: {
1.15 ! noro 448: int *c;
! 449: DCP dc,dc0;
! 450: int i,t;
! 451: GFS q;
! 452:
! 453: if ( DEG(w) < 0 )
! 454: *f = 0;
! 455: else if ( DEG(w) == 0 ) {
! 456: t = COEF(w)[0];
! 457: t = IFTOF(t);
! 458: MKGFS(t,q);
! 459: *f = (P)q;
! 460: } else {
! 461: for ( i = DEG(w), c = COEF(w), dc0 = 0; i >= 0; i-- )
! 462: if ( c[i] ) {
! 463: NEXTDC(dc0,dc);
! 464: STOQ(i,DEG(dc));
! 465: t = COEF(w)[i];
! 466: t = IFTOF(t);
! 467: MKGFS(t,q);
! 468: COEF(dc) = (P)q;
! 469: }
! 470: NEXT(dc) = 0;
! 471: MKP(v,dc0,*f);
! 472: }
1.1 noro 473: }
474:
1.11 noro 475: void ptoup(P n,UP *nr)
1.1 noro 476: {
1.15 ! noro 477: DCP dc;
! 478: UP r;
! 479: int d;
! 480:
! 481: if ( !n )
! 482: *nr = 0;
! 483: else if ( OID(n) == O_N ) {
! 484: *nr = r = UPALLOC(0);
! 485: DEG(r) = 0; COEF(r)[0] = (Num)n;
! 486: } else {
! 487: d = UDEG(n);
! 488: up_var = VR(n);
! 489: *nr = r = UPALLOC(d); DEG(r) = d;
! 490: for ( dc = DC(n); dc; dc = NEXT(dc) ) {
! 491: COEF(r)[QTOS(DEG(dc))] = (Num)COEF(dc);
! 492: }
! 493: }
1.1 noro 494: }
495:
1.11 noro 496: void uptop(UP n,P *nr)
1.1 noro 497: {
1.15 ! noro 498: int i;
! 499: DCP dc0,dc;
1.1 noro 500:
1.15 ! noro 501: if ( !n )
! 502: *nr = 0;
! 503: else if ( !DEG(n) )
! 504: *nr = (P)COEF(n)[0];
! 505: else {
! 506: for ( i = DEG(n), dc0 = 0; i >= 0; i-- )
! 507: if ( COEF(n)[i] ) {
! 508: NEXTDC(dc0,dc); STOQ(i,DEG(dc)); COEF(dc) = (P)COEF(n)[i];
! 509: }
! 510: if ( !up_var )
! 511: up_var = CO->v;
! 512: MKP(up_var,dc0,*nr);
! 513: }
1.1 noro 514: }
515:
1.11 noro 516: void ulmptoum(int m,UP f,UM wf)
1.1 noro 517: {
1.15 ! noro 518: int i,d;
! 519: LM *c;
1.1 noro 520:
1.15 ! noro 521: if ( !f )
! 522: wf->d = -1;
! 523: else {
! 524: wf->d = d = f->d;
! 525: c = (LM *)f->c;
! 526: for ( i = 0, d = f->d; i <= d; i++ )
! 527: COEF(wf)[i] = rem(c[i]->body,m);
! 528: }
1.1 noro 529: }
530:
1.11 noro 531: void objtobobj(int base,Obj p,Obj *rp)
1.1 noro 532: {
1.15 ! noro 533: if ( !p )
! 534: *rp = 0;
! 535: else
! 536: switch ( OID(p) ) {
! 537: case O_N:
! 538: numtobnum(base,(Num)p,(Num *)rp); break;
! 539: case O_P:
! 540: ptobp(base,(P)p,(P *)rp); break;
! 541: case O_LIST:
! 542: listtoblist(base,(LIST)p,(LIST *)rp); break;
! 543: case O_VECT:
! 544: vecttobvect(base,(VECT)p,(VECT *)rp); break;
! 545: case O_MAT:
! 546: mattobmat(base,(MAT)p,(MAT *)rp); break;
! 547: case O_STR:
! 548: *rp = p; break;
! 549: case O_COMP: default:
! 550: error("objtobobj : not implemented"); break;
! 551: }
1.1 noro 552: }
553:
1.11 noro 554: void bobjtoobj(int base,Obj p,Obj *rp)
1.1 noro 555: {
1.15 ! noro 556: if ( !p )
! 557: *rp = 0;
! 558: else
! 559: switch ( OID(p) ) {
! 560: case O_N:
! 561: bnumtonum(base,(Num)p,(Num *)rp); break;
! 562: case O_P:
! 563: bptop(base,(P)p,(P *)rp); break;
! 564: case O_LIST:
! 565: blisttolist(base,(LIST)p,(LIST *)rp); break;
! 566: case O_VECT:
! 567: bvecttovect(base,(VECT)p,(VECT *)rp); break;
! 568: case O_MAT:
! 569: bmattomat(base,(MAT)p,(MAT *)rp); break;
! 570: case O_STR:
! 571: *rp = p; break;
! 572: case O_COMP: default:
! 573: error("bobjtoobj : not implemented"); break;
! 574: }
1.1 noro 575: }
576:
1.11 noro 577: void numtobnum(int base,Num p,Num *rp)
1.1 noro 578: {
1.15 ! noro 579: N nm,dn,body;
! 580: Q q;
! 581: LM l;
! 582:
! 583: if ( !p )
! 584: *rp = 0;
! 585: else
! 586: switch ( NID(p) ) {
! 587: case N_Q:
! 588: ntobn(base,NM((Q)p),&nm);
! 589: if ( DN((Q)p) ) {
! 590: ntobn(base,DN((Q)p),&dn);
! 591: NDTOQ(nm,dn,SGN((Q)p),q);
! 592: } else
! 593: NTOQ(nm,SGN((Q)p),q);
! 594: *rp = (Num)q;
! 595: break;
! 596: case N_R:
! 597: *rp = p; break;
! 598: case N_LM:
! 599: ntobn(base,((LM)p)->body,&body);
! 600: MKLM(body,l); *rp = (Num)l;
! 601: break;
! 602: default:
! 603: error("numtobnum : not implemented"); break;
! 604: }
1.1 noro 605: }
606:
1.11 noro 607: void bnumtonum(int base,Num p,Num *rp)
1.1 noro 608: {
1.15 ! noro 609: N nm,dn,body;
! 610: Q q;
! 611: LM l;
! 612:
! 613: if ( !p )
! 614: *rp = 0;
! 615: else
! 616: switch ( NID(p) ) {
! 617: case N_Q:
! 618: bnton(base,NM((Q)p),&nm);
! 619: if ( DN((Q)p) ) {
! 620: bnton(base,DN((Q)p),&dn);
! 621: NDTOQ(nm,dn,SGN((Q)p),q);
! 622: } else
! 623: NTOQ(nm,SGN((Q)p),q);
! 624: *rp = (Num)q;
! 625: break;
! 626: case N_R:
! 627: *rp = p; break;
! 628: case N_LM:
! 629: bnton(base,((LM)p)->body,&body);
! 630: MKLM(body,l); *rp = (Num)l;
! 631: break;
! 632: default:
! 633: error("bnumtonum : not implemented"); break;
! 634: }
1.1 noro 635: }
636:
1.11 noro 637: void ptobp(int base,P p,P *rp)
1.1 noro 638: {
1.15 ! noro 639: DCP dcr0,dcr,dc;
1.1 noro 640:
1.15 ! noro 641: if ( !p )
! 642: *rp = p;
! 643: else {
! 644: for ( dcr0 = 0, dc = DC(p); dc; dc = NEXT(dc) ) {
! 645: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc);
! 646: objtobobj(base,(Obj)COEF(dc),(Obj *)&COEF(dcr));
! 647: }
! 648: NEXT(dcr) = 0;
! 649: MKP(VR(p),dcr0,*rp);
! 650: }
1.1 noro 651: }
652:
1.11 noro 653: void bptop(int base,P p,P *rp)
1.1 noro 654: {
1.15 ! noro 655: DCP dcr0,dcr,dc;
1.1 noro 656:
1.15 ! noro 657: if ( !p )
! 658: *rp = p;
! 659: else {
! 660: for ( dcr0 = 0, dc = DC(p); dc; dc = NEXT(dc) ) {
! 661: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc);
! 662: bobjtoobj(base,(Obj)COEF(dc),(Obj *)&COEF(dcr));
! 663: }
! 664: NEXT(dcr) = 0;
! 665: MKP(VR(p),dcr0,*rp);
! 666: }
1.1 noro 667: }
668:
1.11 noro 669: void listtoblist(int base,LIST p,LIST *rp)
1.1 noro 670: {
1.15 ! noro 671: NODE nr0,nr,n;
1.1 noro 672:
1.15 ! noro 673: if ( !p )
! 674: *rp = p;
! 675: else {
! 676: for ( nr0 = 0, n = BDY(p); n; n = NEXT(n) ) {
! 677: NEXTNODE(nr0,nr);
! 678: objtobobj(base,BDY(n),(Obj *)&BDY(nr));
! 679: }
! 680: NEXT(nr) = 0;
! 681: MKLIST(*rp,nr0);
! 682: }
1.1 noro 683: }
684:
1.11 noro 685: void blisttolist(int base,LIST p,LIST *rp)
1.1 noro 686: {
1.15 ! noro 687: NODE nr0,nr,n;
1.1 noro 688:
1.15 ! noro 689: if ( !p )
! 690: *rp = p;
! 691: else {
! 692: for ( nr0 = 0, n = BDY(p); n; n = NEXT(n) ) {
! 693: NEXTNODE(nr0,nr);
! 694: bobjtoobj(base,BDY(n),(Obj *)&BDY(nr));
! 695: }
! 696: NEXT(nr) = 0;
! 697: MKLIST(*rp,nr0);
! 698: }
1.1 noro 699: }
700:
1.11 noro 701: void vecttobvect(int base,VECT p,VECT *rp)
1.1 noro 702: {
1.15 ! noro 703: int i,l;
! 704: VECT r;
1.1 noro 705:
1.15 ! noro 706: if ( !p )
! 707: *rp = p;
! 708: else {
! 709: l = p->len;
! 710: MKVECT(r,l); *rp = r;
! 711: for ( i = 0; i < l; i++ )
! 712: objtobobj(base,p->body[i],(Obj *)&r->body[i]);
! 713: }
1.1 noro 714: }
715:
1.11 noro 716: void bvecttovect(int base,VECT p,VECT *rp)
1.1 noro 717: {
1.15 ! noro 718: int i,l;
! 719: VECT r;
1.1 noro 720:
1.15 ! noro 721: if ( !p )
! 722: *rp = p;
! 723: else {
! 724: l = p->len;
! 725: MKVECT(r,l); *rp = r;
! 726: for ( i = 0; i < l; i++ )
! 727: bobjtoobj(base,p->body[i],(Obj *)&r->body[i]);
! 728: }
1.1 noro 729: }
730:
1.11 noro 731: void mattobmat(int base,MAT p,MAT *rp)
1.1 noro 732: {
1.15 ! noro 733: int row,col,i,j;
! 734: MAT r;
1.1 noro 735:
1.15 ! noro 736: if ( !p )
! 737: *rp = p;
! 738: else {
! 739: row = p->row; col = p->col;
! 740: MKMAT(r,row,col); *rp = r;
! 741: for ( i = 0; i < row; i++ )
! 742: for ( j = 0; i < col; j++ )
! 743: objtobobj(base,p->body[i][j],(Obj *)&r->body[i][j]);
! 744: }
1.1 noro 745: }
746:
1.11 noro 747: void bmattomat(int base,MAT p,MAT *rp)
1.1 noro 748: {
1.15 ! noro 749: int row,col,i,j;
! 750: MAT r;
1.1 noro 751:
1.15 ! noro 752: if ( !p )
! 753: *rp = p;
! 754: else {
! 755: row = p->row; col = p->col;
! 756: MKMAT(r,row,col); *rp = r;
! 757: for ( i = 0; i < row; i++ )
! 758: for ( j = 0; i < col; j++ )
! 759: bobjtoobj(base,p->body[i][j],(Obj *)&r->body[i][j]);
! 760: }
1.1 noro 761: }
762:
1.11 noro 763: void n32ton27(N g,N *rp)
1.1 noro 764: {
1.15 ! noro 765: int i,j,k,l,r,bits,words;
! 766: unsigned int t;
! 767: unsigned int *a,*b;
! 768: N z;
! 769:
! 770: l = PL(g); a = BD(g);
! 771: for ( i = 31, t = a[l-1]; !(t&(1<<i)); i-- );
! 772: bits = (l-1)*32+i+1; words = (bits+26)/27;
! 773: *rp = z = NALLOC(words); PL(z) = words;
! 774: bzero((char *)BD(z),words*sizeof(unsigned int));
! 775: for ( j = 0, b = BD(z); j < words; j++ ) {
! 776: k = (27*j)/32; r = (27*j)%32;
! 777: if ( r > 5 )
! 778: b[j] = (a[k]>>r)|(k==(l-1)?0:((a[k+1]&((1<<(r-5))-1))<<(32-r)));
! 779: else
! 780: b[j] = (a[k]>>r)&((1<<27)-1);
! 781: }
! 782: if ( !(r = bits%27) )
! 783: r = 27;
! 784: b[words-1] &= ((1<<r)-1);
1.1 noro 785: }
786:
1.11 noro 787: void n27ton32(N a,N *rp)
1.1 noro 788: {
1.15 ! noro 789: int i,j,k,l,r,bits,words;
! 790: unsigned int t;
! 791: unsigned int *b,*c;
! 792: N z;
! 793:
! 794: l = PL(a); b = BD(a);
! 795: for ( i = 26, t = b[l-1]; !(t&(1<<i)); i-- );
! 796: bits = (l-1)*27+i+1; words = (bits+31)/32;
! 797: *rp = z = NALLOC(words); PL(z) = words;
! 798: bzero((char *)BD(z),words*sizeof(unsigned int));
! 799: for ( j = 0, c = BD(z); j < l; j++ ) {
! 800: k = (27*j)/32; r = (27*j)%32;
! 801: if ( r > 5 ) {
! 802: c[k] |= (b[j]&((1<<(32-r))-1))<<r;
! 803: if ( k+1 < words )
! 804: c[k+1] = (b[j]>>(32-r));
! 805: } else
! 806: c[k] |= (b[j]<<r);
! 807: }
1.1 noro 808: }
809:
1.11 noro 810: void mptoum(P p,UM pr)
1.1 noro 811: {
1.15 ! noro 812: DCP dc;
1.1 noro 813:
1.15 ! noro 814: if ( !p )
! 815: DEG(pr) = -1;
! 816: else if ( NUM(p) ) {
! 817: DEG(pr) = 0; COEF(pr)[0] = CONT((MQ)p);
! 818: } else {
! 819: bzero((char *)pr,(int)((UDEG(p)+2)*sizeof(int)));
! 820: for ( dc = DC(p); dc; dc = NEXT(dc) )
! 821: COEF(pr)[QTOS(DEG(dc))] = CONT((MQ)COEF(dc));
! 822: degum(pr,UDEG(p));
! 823: }
1.1 noro 824: }
825:
1.11 noro 826: void umtomp(V v,UM p,P *pr)
1.1 noro 827: {
1.15 ! noro 828: DCP dc,dc0;
! 829: int i;
! 830: MQ q;
! 831:
! 832: if ( !p || (DEG(p) < 0) )
! 833: *pr = 0;
! 834: else if ( !DEG(p) )
! 835: STOMQ(COEF(p)[0],q), *pr = (P)q;
! 836: else {
! 837: for ( dc0 = 0, i = DEG(p); i >= 0; i-- )
! 838: if ( COEF(p)[i] ) {
! 839: NEXTDC(dc0,dc); STOQ(i,DEG(dc));
! 840: STOMQ(COEF(p)[i],q), COEF(dc) = (P)q;
! 841: }
! 842: NEXT(dc) = 0; MKP(v,dc0,*pr);
! 843: }
1.6 noro 844: }
845:
846: /* f(p) -> f(x) */
847:
1.11 noro 848: void enc_to_p(int p,int a,V v,P *pr)
1.6 noro 849: {
1.15 ! noro 850: DCP dc,dct;
! 851: int i,c;
! 852: Q dq,cq;
! 853:
! 854: dc = 0;
! 855: for ( i = 0; a; i++, a /= p ) {
! 856: c = a%p;
! 857: if ( c ) {
! 858: STOQ(i,dq); STOQ(c,cq);
! 859: NEWDC(dct); DEG(dct) = dq; COEF(dct) = (P)cq;
! 860: NEXT(dct) = dc; dc = dct;
! 861: }
! 862: }
! 863: MKP(v,dc,*pr);
1.1 noro 864: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to C.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / engine