![[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.11 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/engine/C.c,v 1.10 2001/06/29 09:08:53 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;
407: COEF(wf)[0] = FTOIF(CONT((GFS)f));
408: return;
409: }
1.8 noro 410:
411: for ( i = UDEG(f); i >= 0; i-- )
412: COEF(wf)[i] = 0;
413:
414: for ( dc = DC(f); dc; dc = NEXT(dc) ) {
415: c = (GFS)COEF(dc);
416: if ( c )
417: COEF(wf)[QTOS(DEG(dc))] = FTOIF(CONT(c));
418: }
419: degum(wf,UDEG(f));
420: }
421:
1.11 ! noro 422: void sfumtop(V v,UM w,P *f)
1.8 noro 423: {
424: int *c;
425: DCP dc,dc0;
426: int i,t;
427: GFS q;
428:
429: if ( DEG(w) < 0 )
430: *f = 0;
431: else if ( DEG(w) == 0 ) {
432: t = COEF(w)[0];
433: t = IFTOF(t);
434: MKGFS(t,q);
435: *f = (P)q;
436: } else {
437: for ( i = DEG(w), c = COEF(w), dc0 = 0; i >= 0; i-- )
438: if ( c[i] ) {
439: NEXTDC(dc0,dc);
440: STOQ(i,DEG(dc));
441: t = COEF(w)[i];
442: t = IFTOF(t);
443: MKGFS(t,q);
444: COEF(dc) = (P)q;
1.1 noro 445: }
446: NEXT(dc) = 0;
447: MKP(v,dc0,*f);
448: }
449: }
450:
1.11 ! noro 451: void ptoup(P n,UP *nr)
1.1 noro 452: {
453: DCP dc;
454: UP r;
455: int d;
456:
457: if ( !n )
458: *nr = 0;
459: else if ( OID(n) == O_N ) {
460: *nr = r = UPALLOC(0);
461: DEG(r) = 0; COEF(r)[0] = (Num)n;
462: } else {
463: d = UDEG(n);
464: up_var = VR(n);
465: *nr = r = UPALLOC(d); DEG(r) = d;
466: for ( dc = DC(n); dc; dc = NEXT(dc) ) {
467: COEF(r)[QTOS(DEG(dc))] = (Num)COEF(dc);
468: }
469: }
470: }
471:
1.11 ! noro 472: void uptop(UP n,P *nr)
1.1 noro 473: {
474: int i;
475: DCP dc0,dc;
476:
477: if ( !n )
478: *nr = 0;
479: else if ( !DEG(n) )
480: *nr = (P)COEF(n)[0];
481: else {
482: for ( i = DEG(n), dc0 = 0; i >= 0; i-- )
483: if ( COEF(n)[i] ) {
484: NEXTDC(dc0,dc); STOQ(i,DEG(dc)); COEF(dc) = (P)COEF(n)[i];
485: }
486: if ( !up_var )
487: up_var = CO->v;
488: MKP(up_var,dc0,*nr);
489: }
490: }
491:
1.11 ! noro 492: void ulmptoum(int m,UP f,UM wf)
1.1 noro 493: {
494: int i,d;
495: LM *c;
496:
497: if ( !f )
498: wf->d = -1;
499: else {
500: wf->d = d = f->d;
501: c = (LM *)f->c;
502: for ( i = 0, d = f->d; i <= d; i++ )
503: COEF(wf)[i] = rem(c[i]->body,m);
504: }
505: }
506:
1.11 ! noro 507: void objtobobj(int base,Obj p,Obj *rp)
1.1 noro 508: {
509: if ( !p )
510: *rp = 0;
511: else
512: switch ( OID(p) ) {
513: case O_N:
514: numtobnum(base,(Num)p,(Num *)rp); break;
515: case O_P:
516: ptobp(base,(P)p,(P *)rp); break;
517: case O_LIST:
518: listtoblist(base,(LIST)p,(LIST *)rp); break;
519: case O_VECT:
520: vecttobvect(base,(VECT)p,(VECT *)rp); break;
521: case O_MAT:
522: mattobmat(base,(MAT)p,(MAT *)rp); break;
523: case O_STR:
524: *rp = p; break;
525: case O_COMP: default:
526: error("objtobobj : not implemented"); break;
527: }
528: }
529:
1.11 ! noro 530: void bobjtoobj(int base,Obj p,Obj *rp)
1.1 noro 531: {
532: if ( !p )
533: *rp = 0;
534: else
535: switch ( OID(p) ) {
536: case O_N:
537: bnumtonum(base,(Num)p,(Num *)rp); break;
538: case O_P:
539: bptop(base,(P)p,(P *)rp); break;
540: case O_LIST:
541: blisttolist(base,(LIST)p,(LIST *)rp); break;
542: case O_VECT:
543: bvecttovect(base,(VECT)p,(VECT *)rp); break;
544: case O_MAT:
545: bmattomat(base,(MAT)p,(MAT *)rp); break;
546: case O_STR:
547: *rp = p; break;
548: case O_COMP: default:
549: error("bobjtoobj : not implemented"); break;
550: }
551: }
552:
1.11 ! noro 553: void numtobnum(int base,Num p,Num *rp)
1.1 noro 554: {
555: N nm,dn,body;
556: Q q;
557: LM l;
558:
559: if ( !p )
560: *rp = 0;
561: else
562: switch ( NID(p) ) {
563: case N_Q:
564: ntobn(base,NM((Q)p),&nm);
565: if ( DN((Q)p) ) {
566: ntobn(base,DN((Q)p),&dn);
567: NDTOQ(nm,dn,SGN((Q)p),q);
568: } else
569: NTOQ(nm,SGN((Q)p),q);
570: *rp = (Num)q;
571: break;
572: case N_R:
573: *rp = p; break;
574: case N_LM:
575: ntobn(base,((LM)p)->body,&body);
576: MKLM(body,l); *rp = (Num)l;
577: break;
578: default:
579: error("numtobnum : not implemented"); break;
580: }
581: }
582:
1.11 ! noro 583: void bnumtonum(int base,Num p,Num *rp)
1.1 noro 584: {
585: N nm,dn,body;
586: Q q;
587: LM l;
588:
589: if ( !p )
590: *rp = 0;
591: else
592: switch ( NID(p) ) {
593: case N_Q:
594: bnton(base,NM((Q)p),&nm);
595: if ( DN((Q)p) ) {
596: bnton(base,DN((Q)p),&dn);
597: NDTOQ(nm,dn,SGN((Q)p),q);
598: } else
599: NTOQ(nm,SGN((Q)p),q);
600: *rp = (Num)q;
601: break;
602: case N_R:
603: *rp = p; break;
604: case N_LM:
605: bnton(base,((LM)p)->body,&body);
606: MKLM(body,l); *rp = (Num)l;
607: break;
608: default:
609: error("bnumtonum : not implemented"); break;
610: }
611: }
612:
1.11 ! noro 613: void ptobp(int base,P p,P *rp)
1.1 noro 614: {
615: DCP dcr0,dcr,dc;
616:
617: if ( !p )
618: *rp = p;
619: else {
620: for ( dcr0 = 0, dc = DC(p); dc; dc = NEXT(dc) ) {
621: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc);
622: objtobobj(base,(Obj)COEF(dc),(Obj *)&COEF(dcr));
623: }
624: NEXT(dcr) = 0;
625: MKP(VR(p),dcr0,*rp);
626: }
627: }
628:
1.11 ! noro 629: void bptop(int base,P p,P *rp)
1.1 noro 630: {
631: DCP dcr0,dcr,dc;
632:
633: if ( !p )
634: *rp = p;
635: else {
636: for ( dcr0 = 0, dc = DC(p); dc; dc = NEXT(dc) ) {
637: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc);
638: bobjtoobj(base,(Obj)COEF(dc),(Obj *)&COEF(dcr));
639: }
640: NEXT(dcr) = 0;
641: MKP(VR(p),dcr0,*rp);
642: }
643: }
644:
1.11 ! noro 645: void listtoblist(int base,LIST p,LIST *rp)
1.1 noro 646: {
647: NODE nr0,nr,n;
648:
649: if ( !p )
650: *rp = p;
651: else {
652: for ( nr0 = 0, n = BDY(p); n; n = NEXT(n) ) {
653: NEXTNODE(nr0,nr);
654: objtobobj(base,BDY(n),(Obj *)&BDY(nr));
655: }
656: NEXT(nr) = 0;
657: MKLIST(*rp,nr0);
658: }
659: }
660:
1.11 ! noro 661: void blisttolist(int base,LIST p,LIST *rp)
1.1 noro 662: {
663: NODE nr0,nr,n;
664:
665: if ( !p )
666: *rp = p;
667: else {
668: for ( nr0 = 0, n = BDY(p); n; n = NEXT(n) ) {
669: NEXTNODE(nr0,nr);
670: bobjtoobj(base,BDY(n),(Obj *)&BDY(nr));
671: }
672: NEXT(nr) = 0;
673: MKLIST(*rp,nr0);
674: }
675: }
676:
1.11 ! noro 677: void vecttobvect(int base,VECT p,VECT *rp)
1.1 noro 678: {
679: int i,l;
680: VECT r;
681:
682: if ( !p )
683: *rp = p;
684: else {
685: l = p->len;
686: MKVECT(r,l); *rp = r;
687: for ( i = 0; i < l; i++ )
688: objtobobj(base,p->body[i],(Obj *)&r->body[i]);
689: }
690: }
691:
1.11 ! noro 692: void bvecttovect(int base,VECT p,VECT *rp)
1.1 noro 693: {
694: int i,l;
695: VECT r;
696:
697: if ( !p )
698: *rp = p;
699: else {
700: l = p->len;
701: MKVECT(r,l); *rp = r;
702: for ( i = 0; i < l; i++ )
703: bobjtoobj(base,p->body[i],(Obj *)&r->body[i]);
704: }
705: }
706:
1.11 ! noro 707: void mattobmat(int base,MAT p,MAT *rp)
1.1 noro 708: {
709: int row,col,i,j;
710: MAT r;
711:
712: if ( !p )
713: *rp = p;
714: else {
715: row = p->row; col = p->col;
716: MKMAT(r,row,col); *rp = r;
717: for ( i = 0; i < row; i++ )
718: for ( j = 0; i < col; j++ )
719: objtobobj(base,p->body[i][j],(Obj *)&r->body[i][j]);
720: }
721: }
722:
1.11 ! noro 723: void bmattomat(int base,MAT p,MAT *rp)
1.1 noro 724: {
725: int row,col,i,j;
726: MAT r;
727:
728: if ( !p )
729: *rp = p;
730: else {
731: row = p->row; col = p->col;
732: MKMAT(r,row,col); *rp = r;
733: for ( i = 0; i < row; i++ )
734: for ( j = 0; i < col; j++ )
735: bobjtoobj(base,p->body[i][j],(Obj *)&r->body[i][j]);
736: }
737: }
738:
1.11 ! noro 739: void n32ton27(N g,N *rp)
1.1 noro 740: {
741: int i,j,k,l,r,bits,words;
742: unsigned int t;
743: unsigned int *a,*b;
744: N z;
745:
746: l = PL(g); a = BD(g);
747: for ( i = 31, t = a[l-1]; !(t&(1<<i)); i-- );
748: bits = (l-1)*32+i+1; words = (bits+26)/27;
749: *rp = z = NALLOC(words); PL(z) = words;
750: bzero((char *)BD(z),words*sizeof(unsigned int));
751: for ( j = 0, b = BD(z); j < words; j++ ) {
752: k = (27*j)/32; r = (27*j)%32;
753: if ( r > 5 )
754: b[j] = (a[k]>>r)|(k==(l-1)?0:((a[k+1]&((1<<(r-5))-1))<<(32-r)));
755: else
756: b[j] = (a[k]>>r)&((1<<27)-1);
757: }
758: if ( !(r = bits%27) )
759: r = 27;
760: b[words-1] &= ((1<<r)-1);
761: }
762:
1.11 ! noro 763: void n27ton32(N a,N *rp)
1.1 noro 764: {
765: int i,j,k,l,r,bits,words;
766: unsigned int t;
767: unsigned int *b,*c;
768: N z;
769:
770: l = PL(a); b = BD(a);
771: for ( i = 26, t = b[l-1]; !(t&(1<<i)); i-- );
772: bits = (l-1)*27+i+1; words = (bits+31)/32;
773: *rp = z = NALLOC(words); PL(z) = words;
774: bzero((char *)BD(z),words*sizeof(unsigned int));
775: for ( j = 0, c = BD(z); j < l; j++ ) {
776: k = (27*j)/32; r = (27*j)%32;
777: if ( r > 5 ) {
778: c[k] |= (b[j]&((1<<(32-r))-1))<<r;
779: if ( k+1 < words )
780: c[k+1] = (b[j]>>(32-r));
781: } else
782: c[k] |= (b[j]<<r);
783: }
784: }
785:
1.11 ! noro 786: void mptoum(P p,UM pr)
1.1 noro 787: {
788: DCP dc;
789:
790: if ( !p )
791: DEG(pr) = -1;
792: else if ( NUM(p) ) {
793: DEG(pr) = 0; COEF(pr)[0] = CONT((MQ)p);
794: } else {
795: bzero((char *)pr,(int)((UDEG(p)+2)*sizeof(int)));
796: for ( dc = DC(p); dc; dc = NEXT(dc) )
797: COEF(pr)[QTOS(DEG(dc))] = CONT((MQ)COEF(dc));
798: degum(pr,UDEG(p));
799: }
800: }
801:
1.11 ! noro 802: void umtomp(V v,UM p,P *pr)
1.1 noro 803: {
804: DCP dc,dc0;
805: int i;
806: MQ q;
807:
808: if ( !p || (DEG(p) < 0) )
809: *pr = 0;
810: else if ( !DEG(p) )
811: STOMQ(COEF(p)[0],q), *pr = (P)q;
812: else {
813: for ( dc0 = 0, i = DEG(p); i >= 0; i-- )
814: if ( COEF(p)[i] ) {
815: NEXTDC(dc0,dc); STOQ(i,DEG(dc));
816: STOMQ(COEF(p)[i],q), COEF(dc) = (P)q;
817: }
818: NEXT(dc) = 0; MKP(v,dc0,*pr);
819: }
1.6 noro 820: }
821:
822: /* f(p) -> f(x) */
823:
1.11 ! noro 824: void enc_to_p(int p,int a,V v,P *pr)
1.6 noro 825: {
826: DCP dc,dct;
827: int i,c;
828: Q dq,cq;
829:
830: dc = 0;
831: for ( i = 0; a; i++, a /= p ) {
832: c = a%p;
833: if ( c ) {
834: STOQ(i,dq); STOQ(c,cq);
835: NEWDC(dct); DEG(dct) = dq; COEF(dct) = (P)cq;
836: NEXT(dct) = dc; dc = dct;
837: }
838: }
839: MKP(v,dc,*pr);
1.1 noro 840: }