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