![[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.13 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/engine/C.c,v 1.12 2002/11/01 06:47:41 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.1 noro 263: }
264: NEXT(dcr) = 0; MKP(VR(f),dcr0,*gp);
1.7 noro 265: }
266: }
267:
1.11 noro 268: void sf_galois_action(P p,Q e,P *pr)
1.7 noro 269: {
270: DCP dc,dcr,dcr0;
271: GFS a;
272: P t;
273:
274: if ( !p )
275: *pr = 0;
276: else if ( NUM(p) ) {
1.11 noro 277: gfs_galois_action((GFS)p,e,&a); *pr = (P)a;
1.7 noro 278: } else {
279: for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
280: sf_galois_action(COEF(dc),e,&t);
1.10 noro 281: if ( t ) {
282: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
283: }
284: }
285: if ( !dcr0 )
286: *pr = 0;
287: else {
288: NEXT(dcr) = 0; MKP(VR(p),dcr0,*pr);
289: }
290: }
291: }
292:
293: /* GF(pn)={0,1,a,a^2,...} -> GF(pm)={0,1,b,b^2,..} ; a -> b^k */
294:
1.11 noro 295: void sf_embed(P p,int k,int pm,P *pr)
1.10 noro 296: {
297: DCP dc,dcr,dcr0;
298: GFS a;
299: P t;
300:
301: if ( !p )
302: *pr = 0;
303: else if ( NUM(p) ) {
1.11 noro 304: gfs_embed((GFS)p,k,pm,&a); *pr = (P)a;
1.10 noro 305: } else {
306: for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
307: sf_embed(COEF(dc),k,pm,&t);
1.7 noro 308: if ( t ) {
309: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
310: }
311: }
312: if ( !dcr0 )
313: *pr = 0;
314: else {
315: NEXT(dcr) = 0; MKP(VR(p),dcr0,*pr);
316: }
1.1 noro 317: }
318: }
319:
1.11 noro 320: void ptolmp(P p,P *pr)
1.1 noro 321: {
322: DCP dc,dcr,dcr0;
323: LM a;
324: P t;
325:
326: if ( !p )
327: *pr = 0;
328: else if ( NUM(p) ) {
329: qtolm((Q)p,&a); *pr = (P)a;
330: } else {
331: for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
332: ptolmp(COEF(dc),&t);
333: if ( t ) {
334: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
335: }
336: }
337: if ( !dcr0 )
338: *pr = 0;
339: else {
340: NEXT(dcr) = 0; MKP(VR(p),dcr0,*pr);
341: }
342: }
343: }
344:
1.11 noro 345: void lmptop(P f,P *gp)
1.1 noro 346: {
347: DCP dc,dcr,dcr0;
348: Q q;
349:
350: if ( !f )
351: *gp = 0;
352: else if ( NUM(f) ) {
353: NTOQ(((LM)f)->body,1,q); *gp = (P)q;
354: } else {
355: for ( dc = DC(f), dcr0 = 0; dc; dc = NEXT(dc) ) {
356: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); lmptop(COEF(dc),&COEF(dcr));
357: }
358: NEXT(dcr) = 0; MKP(VR(f),dcr0,*gp);
359: }
360: }
361:
1.11 noro 362: void ptoum(int m,P f,UM wf)
1.1 noro 363: {
364: unsigned int r;
365: int i;
366: DCP dc;
367:
368: for ( i = UDEG(f); i >= 0; i-- )
369: COEF(wf)[i] = 0;
370:
371: for ( dc = DC(f); dc; dc = NEXT(dc) ) {
372: r = rem(NM((Q)COEF(dc)),m);
373: if ( r && (SGN((Q)COEF(dc)) < 0) )
374: r = m-r;
375: COEF(wf)[QTOS(DEG(dc))] = r;
376: }
377: degum(wf,UDEG(f));
378: }
379:
1.11 noro 380: void umtop(V v,UM w,P *f)
1.1 noro 381: {
382: int *c;
383: DCP dc,dc0;
384: int i;
385: Q q;
386:
387: if ( DEG(w) < 0 )
388: *f = 0;
389: else if ( DEG(w) == 0 )
390: STOQ(COEF(w)[0],q), *f = (P)q;
391: else {
392: for ( i = DEG(w), c = COEF(w), dc0 = 0; i >= 0; i-- )
393: if ( c[i] ) {
394: NEXTDC(dc0,dc);
395: STOQ(i,DEG(dc));
396: STOQ(c[i],q), COEF(dc) = (P)q;
1.8 noro 397: }
398: NEXT(dc) = 0;
399: MKP(v,dc0,*f);
400: }
401: }
402:
1.11 noro 403: void ptosfum(P f,UM wf)
1.8 noro 404: {
405: GFS c;
406: int i;
407: DCP dc;
1.9 noro 408:
409: if ( OID(f) == O_N ) {
410: DEG(wf) = 0;
1.12 noro 411: ntogfs((Obj)f,&c);
412: COEF(wf)[0] = FTOIF(CONT(c));
1.9 noro 413: return;
414: }
1.8 noro 415:
416: for ( i = UDEG(f); i >= 0; i-- )
417: COEF(wf)[i] = 0;
418:
419: for ( dc = DC(f); dc; dc = NEXT(dc) ) {
1.12 noro 420: ntogfs((Obj)COEF(dc),&c);
1.8 noro 421: if ( c )
422: COEF(wf)[QTOS(DEG(dc))] = FTOIF(CONT(c));
423: }
424: degum(wf,UDEG(f));
425: }
426:
1.11 noro 427: void sfumtop(V v,UM w,P *f)
1.8 noro 428: {
429: int *c;
430: DCP dc,dc0;
431: int i,t;
432: GFS q;
433:
434: if ( DEG(w) < 0 )
435: *f = 0;
436: else if ( DEG(w) == 0 ) {
437: t = COEF(w)[0];
438: t = IFTOF(t);
439: MKGFS(t,q);
440: *f = (P)q;
441: } else {
442: for ( i = DEG(w), c = COEF(w), dc0 = 0; i >= 0; i-- )
443: if ( c[i] ) {
444: NEXTDC(dc0,dc);
445: STOQ(i,DEG(dc));
446: t = COEF(w)[i];
447: t = IFTOF(t);
448: MKGFS(t,q);
449: COEF(dc) = (P)q;
1.1 noro 450: }
451: NEXT(dc) = 0;
452: MKP(v,dc0,*f);
453: }
454: }
455:
1.11 noro 456: void ptoup(P n,UP *nr)
1.1 noro 457: {
458: DCP dc;
459: UP r;
460: int d;
461:
462: if ( !n )
463: *nr = 0;
464: else if ( OID(n) == O_N ) {
465: *nr = r = UPALLOC(0);
466: DEG(r) = 0; COEF(r)[0] = (Num)n;
467: } else {
468: d = UDEG(n);
469: up_var = VR(n);
470: *nr = r = UPALLOC(d); DEG(r) = d;
471: for ( dc = DC(n); dc; dc = NEXT(dc) ) {
472: COEF(r)[QTOS(DEG(dc))] = (Num)COEF(dc);
473: }
474: }
475: }
476:
1.11 noro 477: void uptop(UP n,P *nr)
1.1 noro 478: {
479: int i;
480: DCP dc0,dc;
481:
482: if ( !n )
483: *nr = 0;
484: else if ( !DEG(n) )
485: *nr = (P)COEF(n)[0];
486: else {
487: for ( i = DEG(n), dc0 = 0; i >= 0; i-- )
488: if ( COEF(n)[i] ) {
489: NEXTDC(dc0,dc); STOQ(i,DEG(dc)); COEF(dc) = (P)COEF(n)[i];
490: }
491: if ( !up_var )
492: up_var = CO->v;
493: MKP(up_var,dc0,*nr);
494: }
495: }
496:
1.11 noro 497: void ulmptoum(int m,UP f,UM wf)
1.1 noro 498: {
499: int i,d;
500: LM *c;
501:
502: if ( !f )
503: wf->d = -1;
504: else {
505: wf->d = d = f->d;
506: c = (LM *)f->c;
507: for ( i = 0, d = f->d; i <= d; i++ )
508: COEF(wf)[i] = rem(c[i]->body,m);
509: }
510: }
511:
1.11 noro 512: void objtobobj(int base,Obj p,Obj *rp)
1.1 noro 513: {
514: if ( !p )
515: *rp = 0;
516: else
517: switch ( OID(p) ) {
518: case O_N:
519: numtobnum(base,(Num)p,(Num *)rp); break;
520: case O_P:
521: ptobp(base,(P)p,(P *)rp); break;
522: case O_LIST:
523: listtoblist(base,(LIST)p,(LIST *)rp); break;
524: case O_VECT:
525: vecttobvect(base,(VECT)p,(VECT *)rp); break;
526: case O_MAT:
527: mattobmat(base,(MAT)p,(MAT *)rp); break;
528: case O_STR:
529: *rp = p; break;
530: case O_COMP: default:
531: error("objtobobj : not implemented"); break;
532: }
533: }
534:
1.11 noro 535: void bobjtoobj(int base,Obj p,Obj *rp)
1.1 noro 536: {
537: if ( !p )
538: *rp = 0;
539: else
540: switch ( OID(p) ) {
541: case O_N:
542: bnumtonum(base,(Num)p,(Num *)rp); break;
543: case O_P:
544: bptop(base,(P)p,(P *)rp); break;
545: case O_LIST:
546: blisttolist(base,(LIST)p,(LIST *)rp); break;
547: case O_VECT:
548: bvecttovect(base,(VECT)p,(VECT *)rp); break;
549: case O_MAT:
550: bmattomat(base,(MAT)p,(MAT *)rp); break;
551: case O_STR:
552: *rp = p; break;
553: case O_COMP: default:
554: error("bobjtoobj : not implemented"); break;
555: }
556: }
557:
1.11 noro 558: void numtobnum(int base,Num p,Num *rp)
1.1 noro 559: {
560: N nm,dn,body;
561: Q q;
562: LM l;
563:
564: if ( !p )
565: *rp = 0;
566: else
567: switch ( NID(p) ) {
568: case N_Q:
569: ntobn(base,NM((Q)p),&nm);
570: if ( DN((Q)p) ) {
571: ntobn(base,DN((Q)p),&dn);
572: NDTOQ(nm,dn,SGN((Q)p),q);
573: } else
574: NTOQ(nm,SGN((Q)p),q);
575: *rp = (Num)q;
576: break;
577: case N_R:
578: *rp = p; break;
579: case N_LM:
580: ntobn(base,((LM)p)->body,&body);
581: MKLM(body,l); *rp = (Num)l;
582: break;
583: default:
584: error("numtobnum : not implemented"); break;
585: }
586: }
587:
1.11 noro 588: void bnumtonum(int base,Num p,Num *rp)
1.1 noro 589: {
590: N nm,dn,body;
591: Q q;
592: LM l;
593:
594: if ( !p )
595: *rp = 0;
596: else
597: switch ( NID(p) ) {
598: case N_Q:
599: bnton(base,NM((Q)p),&nm);
600: if ( DN((Q)p) ) {
601: bnton(base,DN((Q)p),&dn);
602: NDTOQ(nm,dn,SGN((Q)p),q);
603: } else
604: NTOQ(nm,SGN((Q)p),q);
605: *rp = (Num)q;
606: break;
607: case N_R:
608: *rp = p; break;
609: case N_LM:
610: bnton(base,((LM)p)->body,&body);
611: MKLM(body,l); *rp = (Num)l;
612: break;
613: default:
614: error("bnumtonum : not implemented"); break;
615: }
616: }
617:
1.11 noro 618: void ptobp(int base,P p,P *rp)
1.1 noro 619: {
620: DCP dcr0,dcr,dc;
621:
622: if ( !p )
623: *rp = p;
624: else {
625: for ( dcr0 = 0, dc = DC(p); dc; dc = NEXT(dc) ) {
626: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc);
627: objtobobj(base,(Obj)COEF(dc),(Obj *)&COEF(dcr));
628: }
629: NEXT(dcr) = 0;
630: MKP(VR(p),dcr0,*rp);
631: }
632: }
633:
1.11 noro 634: void bptop(int base,P p,P *rp)
1.1 noro 635: {
636: DCP dcr0,dcr,dc;
637:
638: if ( !p )
639: *rp = p;
640: else {
641: for ( dcr0 = 0, dc = DC(p); dc; dc = NEXT(dc) ) {
642: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc);
643: bobjtoobj(base,(Obj)COEF(dc),(Obj *)&COEF(dcr));
644: }
645: NEXT(dcr) = 0;
646: MKP(VR(p),dcr0,*rp);
647: }
648: }
649:
1.11 noro 650: void listtoblist(int base,LIST p,LIST *rp)
1.1 noro 651: {
652: NODE nr0,nr,n;
653:
654: if ( !p )
655: *rp = p;
656: else {
657: for ( nr0 = 0, n = BDY(p); n; n = NEXT(n) ) {
658: NEXTNODE(nr0,nr);
659: objtobobj(base,BDY(n),(Obj *)&BDY(nr));
660: }
661: NEXT(nr) = 0;
662: MKLIST(*rp,nr0);
663: }
664: }
665:
1.11 noro 666: void blisttolist(int base,LIST p,LIST *rp)
1.1 noro 667: {
668: NODE nr0,nr,n;
669:
670: if ( !p )
671: *rp = p;
672: else {
673: for ( nr0 = 0, n = BDY(p); n; n = NEXT(n) ) {
674: NEXTNODE(nr0,nr);
675: bobjtoobj(base,BDY(n),(Obj *)&BDY(nr));
676: }
677: NEXT(nr) = 0;
678: MKLIST(*rp,nr0);
679: }
680: }
681:
1.11 noro 682: void vecttobvect(int base,VECT p,VECT *rp)
1.1 noro 683: {
684: int i,l;
685: VECT r;
686:
687: if ( !p )
688: *rp = p;
689: else {
690: l = p->len;
691: MKVECT(r,l); *rp = r;
692: for ( i = 0; i < l; i++ )
693: objtobobj(base,p->body[i],(Obj *)&r->body[i]);
694: }
695: }
696:
1.11 noro 697: void bvecttovect(int base,VECT p,VECT *rp)
1.1 noro 698: {
699: int i,l;
700: VECT r;
701:
702: if ( !p )
703: *rp = p;
704: else {
705: l = p->len;
706: MKVECT(r,l); *rp = r;
707: for ( i = 0; i < l; i++ )
708: bobjtoobj(base,p->body[i],(Obj *)&r->body[i]);
709: }
710: }
711:
1.11 noro 712: void mattobmat(int base,MAT p,MAT *rp)
1.1 noro 713: {
714: int row,col,i,j;
715: MAT r;
716:
717: if ( !p )
718: *rp = p;
719: else {
720: row = p->row; col = p->col;
721: MKMAT(r,row,col); *rp = r;
722: for ( i = 0; i < row; i++ )
723: for ( j = 0; i < col; j++ )
724: objtobobj(base,p->body[i][j],(Obj *)&r->body[i][j]);
725: }
726: }
727:
1.11 noro 728: void bmattomat(int base,MAT p,MAT *rp)
1.1 noro 729: {
730: int row,col,i,j;
731: MAT r;
732:
733: if ( !p )
734: *rp = p;
735: else {
736: row = p->row; col = p->col;
737: MKMAT(r,row,col); *rp = r;
738: for ( i = 0; i < row; i++ )
739: for ( j = 0; i < col; j++ )
740: bobjtoobj(base,p->body[i][j],(Obj *)&r->body[i][j]);
741: }
742: }
743:
1.11 noro 744: void n32ton27(N g,N *rp)
1.1 noro 745: {
746: int i,j,k,l,r,bits,words;
747: unsigned int t;
748: unsigned int *a,*b;
749: N z;
750:
751: l = PL(g); a = BD(g);
752: for ( i = 31, t = a[l-1]; !(t&(1<<i)); i-- );
753: bits = (l-1)*32+i+1; words = (bits+26)/27;
754: *rp = z = NALLOC(words); PL(z) = words;
755: bzero((char *)BD(z),words*sizeof(unsigned int));
756: for ( j = 0, b = BD(z); j < words; j++ ) {
757: k = (27*j)/32; r = (27*j)%32;
758: if ( r > 5 )
759: b[j] = (a[k]>>r)|(k==(l-1)?0:((a[k+1]&((1<<(r-5))-1))<<(32-r)));
760: else
761: b[j] = (a[k]>>r)&((1<<27)-1);
762: }
763: if ( !(r = bits%27) )
764: r = 27;
765: b[words-1] &= ((1<<r)-1);
766: }
767:
1.11 noro 768: void n27ton32(N a,N *rp)
1.1 noro 769: {
770: int i,j,k,l,r,bits,words;
771: unsigned int t;
772: unsigned int *b,*c;
773: N z;
774:
775: l = PL(a); b = BD(a);
776: for ( i = 26, t = b[l-1]; !(t&(1<<i)); i-- );
777: bits = (l-1)*27+i+1; words = (bits+31)/32;
778: *rp = z = NALLOC(words); PL(z) = words;
779: bzero((char *)BD(z),words*sizeof(unsigned int));
780: for ( j = 0, c = BD(z); j < l; j++ ) {
781: k = (27*j)/32; r = (27*j)%32;
782: if ( r > 5 ) {
783: c[k] |= (b[j]&((1<<(32-r))-1))<<r;
784: if ( k+1 < words )
785: c[k+1] = (b[j]>>(32-r));
786: } else
787: c[k] |= (b[j]<<r);
788: }
789: }
790:
1.11 noro 791: void mptoum(P p,UM pr)
1.1 noro 792: {
793: DCP dc;
794:
795: if ( !p )
796: DEG(pr) = -1;
797: else if ( NUM(p) ) {
798: DEG(pr) = 0; COEF(pr)[0] = CONT((MQ)p);
799: } else {
800: bzero((char *)pr,(int)((UDEG(p)+2)*sizeof(int)));
801: for ( dc = DC(p); dc; dc = NEXT(dc) )
802: COEF(pr)[QTOS(DEG(dc))] = CONT((MQ)COEF(dc));
803: degum(pr,UDEG(p));
804: }
805: }
806:
1.11 noro 807: void umtomp(V v,UM p,P *pr)
1.1 noro 808: {
809: DCP dc,dc0;
810: int i;
811: MQ q;
812:
813: if ( !p || (DEG(p) < 0) )
814: *pr = 0;
815: else if ( !DEG(p) )
816: STOMQ(COEF(p)[0],q), *pr = (P)q;
817: else {
818: for ( dc0 = 0, i = DEG(p); i >= 0; i-- )
819: if ( COEF(p)[i] ) {
820: NEXTDC(dc0,dc); STOQ(i,DEG(dc));
821: STOMQ(COEF(p)[i],q), COEF(dc) = (P)q;
822: }
823: NEXT(dc) = 0; MKP(v,dc0,*pr);
824: }
1.6 noro 825: }
826:
827: /* f(p) -> f(x) */
828:
1.11 noro 829: void enc_to_p(int p,int a,V v,P *pr)
1.6 noro 830: {
831: DCP dc,dct;
832: int i,c;
833: Q dq,cq;
834:
835: dc = 0;
836: for ( i = 0; a; i++, a /= p ) {
837: c = a%p;
838: if ( c ) {
839: STOQ(i,dq); STOQ(c,cq);
840: NEWDC(dct); DEG(dct) = dq; COEF(dct) = (P)cq;
841: NEXT(dct) = dc; dc = dct;
842: }
843: }
844: MKP(v,dc,*pr);
1.1 noro 845: }