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