![[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|
Return to C.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / engine |
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.14 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/engine/C.c,v 1.13 2003/01/04 09:06:17 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: {
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: }
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: {
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: }
102: }
103:
1.11 noro 104: void ntobn(int base,N n,N *nrp)
1.1 noro 105: {
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];
138: }
139:
1.11 noro 140: void bnton(int base,N n,N *nrp)
1.1 noro 141: {
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];
166: }
167:
1.11 noro 168: void ptomp(int m,P p,P *pr)
1.1 noro 169: {
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: }
200: }
201:
1.11 noro 202: void mptop(P f,P *gp)
1.1 noro 203: {
204: DCP dc,dcr,dcr0;
205: Q q;
206:
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));
1.4 noro 214: }
215: NEXT(dcr) = 0; MKP(VR(f),dcr0,*gp);
216: }
217: }
218:
1.11 noro 219: void ptosfp(P p,P *pr)
1.7 noro 220: {
221: DCP dc,dcr,dcr0;
222: GFS a;
223: P t;
224:
225: if ( !p )
226: *pr = 0;
227: else if ( NUM(p) ) {
1.13 noro 228: if ( NID((Num)p) == N_GFS )
229: *pr = (P)p;
230: else {
231: qtogfs((Q)p,&a); *pr = (P)a;
232: }
1.7 noro 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: }
246: }
247:
1.11 noro 248: void sfptop(P f,P *gp)
1.4 noro 249: {
250: DCP dc,dcr,dcr0;
251: Q q;
1.5 noro 252: MQ fq;
1.4 noro 253:
254: if ( !f )
255: *gp = 0;
256: else if ( NUM(f) ) {
1.5 noro 257: gfstomq((GFS)f,&fq);
258: STOQ(CONT(fq),q);
259: *gp = (P)q;
1.4 noro 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));
1.14 ! noro 263: }
! 264: NEXT(dcr) = 0; MKP(VR(f),dcr0,*gp);
! 265: }
! 266: }
! 267:
! 268: void sfptopsfp(P f,V v,P *gp)
! 269: {
! 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));
1.1 noro 282: }
283: NEXT(dcr) = 0; MKP(VR(f),dcr0,*gp);
1.7 noro 284: }
285: }
286:
1.11 noro 287: void sf_galois_action(P p,Q e,P *pr)
1.7 noro 288: {
289: DCP dc,dcr,dcr0;
290: GFS a;
291: P t;
292:
293: if ( !p )
294: *pr = 0;
295: else if ( NUM(p) ) {
1.11 noro 296: gfs_galois_action((GFS)p,e,&a); *pr = (P)a;
1.7 noro 297: } else {
298: for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
299: sf_galois_action(COEF(dc),e,&t);
1.10 noro 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: }
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: {
316: DCP dc,dcr,dcr0;
317: GFS a;
318: P t;
319:
320: if ( !p )
321: *pr = 0;
322: else if ( NUM(p) ) {
1.11 noro 323: gfs_embed((GFS)p,k,pm,&a); *pr = (P)a;
1.10 noro 324: } else {
325: for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
326: sf_embed(COEF(dc),k,pm,&t);
1.7 noro 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: }
1.1 noro 336: }
337: }
338:
1.11 noro 339: void ptolmp(P p,P *pr)
1.1 noro 340: {
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: }
362: }
363:
1.11 noro 364: void lmptop(P f,P *gp)
1.1 noro 365: {
366: DCP dc,dcr,dcr0;
367: Q q;
368:
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: }
379: }
380:
1.11 noro 381: void ptoum(int m,P f,UM wf)
1.1 noro 382: {
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));
397: }
398:
1.11 noro 399: void umtop(V v,UM w,P *f)
1.1 noro 400: {
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;
1.8 noro 416: }
417: NEXT(dc) = 0;
418: MKP(v,dc0,*f);
419: }
420: }
421:
1.11 noro 422: void ptosfum(P f,UM wf)
1.8 noro 423: {
424: GFS c;
425: int i;
426: DCP dc;
1.9 noro 427:
428: if ( OID(f) == O_N ) {
429: DEG(wf) = 0;
1.12 noro 430: ntogfs((Obj)f,&c);
431: COEF(wf)[0] = FTOIF(CONT(c));
1.9 noro 432: return;
433: }
1.8 noro 434:
435: for ( i = UDEG(f); i >= 0; i-- )
436: COEF(wf)[i] = 0;
437:
438: for ( dc = DC(f); dc; dc = NEXT(dc) ) {
1.12 noro 439: ntogfs((Obj)COEF(dc),&c);
1.8 noro 440: if ( c )
441: COEF(wf)[QTOS(DEG(dc))] = FTOIF(CONT(c));
442: }
443: degum(wf,UDEG(f));
444: }
445:
1.11 noro 446: void sfumtop(V v,UM w,P *f)
1.8 noro 447: {
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;
1.1 noro 469: }
470: NEXT(dc) = 0;
471: MKP(v,dc0,*f);
472: }
473: }
474:
1.11 noro 475: void ptoup(P n,UP *nr)
1.1 noro 476: {
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: }
494: }
495:
1.11 noro 496: void uptop(UP n,P *nr)
1.1 noro 497: {
498: int i;
499: DCP dc0,dc;
500:
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: }
514: }
515:
1.11 noro 516: void ulmptoum(int m,UP f,UM wf)
1.1 noro 517: {
518: int i,d;
519: LM *c;
520:
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: }
529: }
530:
1.11 noro 531: void objtobobj(int base,Obj p,Obj *rp)
1.1 noro 532: {
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: }
552: }
553:
1.11 noro 554: void bobjtoobj(int base,Obj p,Obj *rp)
1.1 noro 555: {
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: }
575: }
576:
1.11 noro 577: void numtobnum(int base,Num p,Num *rp)
1.1 noro 578: {
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: }
605: }
606:
1.11 noro 607: void bnumtonum(int base,Num p,Num *rp)
1.1 noro 608: {
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: }
635: }
636:
1.11 noro 637: void ptobp(int base,P p,P *rp)
1.1 noro 638: {
639: DCP dcr0,dcr,dc;
640:
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: }
651: }
652:
1.11 noro 653: void bptop(int base,P p,P *rp)
1.1 noro 654: {
655: DCP dcr0,dcr,dc;
656:
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: }
667: }
668:
1.11 noro 669: void listtoblist(int base,LIST p,LIST *rp)
1.1 noro 670: {
671: NODE nr0,nr,n;
672:
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: }
683: }
684:
1.11 noro 685: void blisttolist(int base,LIST p,LIST *rp)
1.1 noro 686: {
687: NODE nr0,nr,n;
688:
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: }
699: }
700:
1.11 noro 701: void vecttobvect(int base,VECT p,VECT *rp)
1.1 noro 702: {
703: int i,l;
704: VECT r;
705:
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: }
714: }
715:
1.11 noro 716: void bvecttovect(int base,VECT p,VECT *rp)
1.1 noro 717: {
718: int i,l;
719: VECT r;
720:
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: }
729: }
730:
1.11 noro 731: void mattobmat(int base,MAT p,MAT *rp)
1.1 noro 732: {
733: int row,col,i,j;
734: MAT r;
735:
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: }
745: }
746:
1.11 noro 747: void bmattomat(int base,MAT p,MAT *rp)
1.1 noro 748: {
749: int row,col,i,j;
750: MAT r;
751:
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: }
761: }
762:
1.11 noro 763: void n32ton27(N g,N *rp)
1.1 noro 764: {
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);
785: }
786:
1.11 noro 787: void n27ton32(N a,N *rp)
1.1 noro 788: {
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: }
808: }
809:
1.11 noro 810: void mptoum(P p,UM pr)
1.1 noro 811: {
812: DCP dc;
813:
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: }
824: }
825:
1.11 noro 826: void umtomp(V v,UM p,P *pr)
1.1 noro 827: {
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: {
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: }