Annotation of OpenXM_contrib/pari/src/kernel/none/level1.h, Revision 1.1.1.1
1.1 maekawa 1: /* $Id: level1.h,v 1.1.1.1 1999/09/16 13:47:55 karim Exp $ */
2:
3: /* This file defines some "level 1" kernel functions */
4: /* These functions can be inline, with gcc */
5: /* If not gcc, they are defined externally with "level1.c" */
6:
7: /* level1.c includes this file and never needs to be changed */
8: /* The following seven lines are necessary for level0.c and level1.c */
9: #ifdef LEVEL1
10: # undef INLINE
11: # define INLINE
12: #endif
13: #ifdef LEVEL0
14: # undef INLINE
15: #endif
16:
17: #ifndef INLINE
18: void addsii(long x, GEN y, GEN z);
19: long addssmod(long a, long b, long p);
20: void addssz(long x, long y, GEN z);
21: void affii(GEN x, GEN y);
22: void affsi(long s, GEN x);
23: void affsr(long s, GEN x);
24: GEN cgetg(long x, long y);
25: GEN cgeti(long x);
26: GEN cgetr(long x);
27: int cmpir(GEN x, GEN y);
28: int cmpsr(long x, GEN y);
29: int divise(GEN x, GEN y);
30: long divisii(GEN x, long y, GEN z);
31: void divisz(GEN x, long y, GEN z);
32: void divrrz(GEN x, GEN y, GEN z);
33: void divsiz(long x, GEN y, GEN z);
34: GEN divss(long x, long y);
35: long divssmod(long a, long b, long p);
36: void divssz(long x, long y, GEN z);
37: void dvmdiiz(GEN x, GEN y, GEN z, GEN t);
38: GEN dvmdis(GEN x, long y, GEN *z);
39: void dvmdisz(GEN x, long y, GEN z, GEN t);
40: GEN dvmdsi(long x, GEN y, GEN *z);
41: void dvmdsiz(long x, GEN y, GEN z, GEN t);
42: GEN dvmdss(long x, long y, GEN *z);
43: void dvmdssz(long x, long y, GEN z, GEN t);
44: ulong evallg(ulong x);
45: ulong evallgef(ulong x);
46: #ifndef __M68K__
47: long expi(GEN x);
48: #endif
49: double gtodouble(GEN x);
50: GEN icopy(GEN x);
51: GEN icopy_av(GEN x, GEN y);
52: long itos(GEN x);
53: GEN modis(GEN x, long y);
54: GEN mpabs(GEN x);
55: GEN mpadd(GEN x, GEN y);
56: void mpaff(GEN x, GEN y);
57: int mpcmp(GEN x, GEN y);
58: GEN mpcopy(GEN x);
59: GEN mpdiv(GEN x, GEN y);
60: int mpdivis(GEN x, GEN y, GEN z);
61: GEN mpmul(GEN x, GEN y);
62: GEN mpneg(GEN x);
63: GEN mpsub(GEN x, GEN y);
64: void mulsii(long x, GEN y, GEN z);
65: long mulssmod(ulong a, ulong b, ulong c);
66: void mulssz(long x, long y, GEN z);
67: GEN new_chunk(long x);
68: void resiiz(GEN x, GEN y, GEN z);
69: GEN resis(GEN x, long y);
70: GEN ressi(long x, GEN y);
71: GEN shiftr(GEN x, long n);
72: long smodis(GEN x, long y);
73: GEN stoi(long x);
74: GEN subii(GEN x, GEN y);
75: GEN subir(GEN x, GEN y);
76: GEN subri(GEN x, GEN y);
77: GEN subrr(GEN x, GEN y);
78: GEN subsi(long x, GEN y);
79: GEN subsr(long x, GEN y);
80: long subssmod(long a, long b, long p);
81: GEN utoi(ulong x);
82: long vali(GEN x);
83:
84: #else /* defined(INLINE) */
85: INLINE ulong
86: evallg(ulong x)
87: {
88: if (x & ~LGBITS) err(errlg);
89: return m_evallg(x);
90: }
91:
92: INLINE ulong
93: evallgef(ulong x)
94: {
95: if (x & ~LGEFBITS) err(errlgef);
96: return m_evallgef(x);
97: }
98:
99: INLINE GEN
100: new_chunk(long x)
101: {
102: const GEN z = ((GEN) avma) - x;
103: if ((ulong)x > (ulong)((GEN)avma-(GEN)bot)) err(errpile);
104: #ifdef MEMSTEP
105: checkmemory(z);
106: #endif
107: #ifdef _WIN32
108: if (win32ctrlc) dowin32ctrlc();
109: #endif
110: avma = (long)z; return z;
111: }
112:
113: /* THE FOLLOWING ONES ARE IN mp.s */
114: # ifndef __M68K__
115:
116: INLINE GEN
117: cgetg(long x, long y)
118: {
119: const GEN z = new_chunk(x);
120: z[0] = evaltyp(y) | evallg(x);
121: return z;
122: }
123:
124: INLINE GEN
125: cgeti(long x)
126: {
127: const GEN z = new_chunk(x);
128: z[0] = evaltyp(t_INT) | evallg(x);
129: return z;
130: }
131:
132: INLINE GEN
133: cgetr(long x)
134: {
135: const GEN z = new_chunk(x);
136: z[0] = evaltyp(t_REAL) | evallg(x);
137: return z;
138: }
139: # endif /* __M68K__ */
140:
141: /* cannot do memcpy because sometimes x and y overlap */
142: INLINE GEN
143: mpcopy(GEN x)
144: {
145: register long lx = lg(x);
146: const GEN y = new_chunk(lx);
147:
148: while (--lx >= 0) y[lx]=x[lx];
149: return y;
150: }
151:
152: INLINE GEN
153: icopy(GEN x)
154: {
155: register long lx = lgefint(x);
156: const GEN y = cgeti(lx);
157:
158: while (--lx > 0) y[lx]=x[lx];
159: return y;
160: }
161:
162: /* copy integer x as if we had avma = av */
163: INLINE GEN
164: icopy_av(GEN x, GEN y)
165: {
166: register long lx = lgefint(x);
167:
168: y -= lx; while (--lx >= 0) y[lx]=x[lx];
169: return y;
170: }
171:
172: INLINE GEN
173: mpneg(GEN x)
174: {
175: const GEN y=mpcopy(x);
176: setsigne(y,-signe(x)); return y;
177: }
178:
179: INLINE GEN
180: mpabs(GEN x)
181: {
182: const GEN y=mpcopy(x);
183: if (signe(x)<0) setsigne(y,1);
184: return y;
185: }
186:
187: INLINE long
188: smodis(GEN x, long y)
189: {
190: const long av=avma; divis(x,y); avma=av;
191: if (!hiremainder) return 0;
192: return (signe(x)>0) ? hiremainder: labs(y)+hiremainder;
193: }
194:
195: INLINE GEN
196: utoi(ulong x)
197: {
198: GEN y;
199:
200: if (!x) return gzero;
201: y=cgeti(3); y[1] = evalsigne(1) | evallgefint(3); y[2] = x;
202: return y;
203: }
204:
205: # ifndef __M68K__
206: INLINE GEN
207: stoi(long x)
208: {
209: GEN y;
210:
211: if (!x) return gzero;
212: y=cgeti(3);
213: if (x>0) { y[1] = evalsigne(1) | evallgefint(3); y[2] = x; }
214: else { y[1] = evalsigne(-1) | evallgefint(3); y[2] = -x; }
215: return y;
216: }
217:
218: INLINE long
219: itos(GEN x)
220: {
221: const long s=signe(x);
222: long p1;
223:
224: if (!s) return 0;
225: if (lgefint(x)>3) err(affer2);
226: p1=x[2]; if (p1 < 0) err(affer2);
227: return (s>0) ? p1 : -(long)p1;
228: }
229: #endif
230:
231: INLINE GEN
232: stosmall(long x)
233: {
234: if (labs(x) & SMALL_MASK) return stoi(x);
235: return (GEN) (1 | (x<<1));
236: }
237:
238: # ifndef __M68K__
239:
240: INLINE void
241: affii(GEN x, GEN y)
242: {
243: long lx;
244:
245: if (x==y) return;
246: lx=lgefint(x); if (lg(y)<lx) err(affer3);
247: while (--lx) y[lx]=x[lx];
248: }
249:
250: INLINE void
251: affsi(long s, GEN x)
252: {
253: if (!s) { x[1]=2; return; }
254: if (lg(x)<3) err(affer1);
255: if (s>0) { x[1] = evalsigne(1) | evallgefint(3); x[2] = s; }
256: else { x[1] = evalsigne(-1) | evallgefint(3); x[2] = -s; }
257: }
258:
259: INLINE void
260: affsr(long s, GEN x)
261: {
262: long l;
263:
264: if (!s)
265: {
266: l = -bit_accuracy(lg(x));
267: x[1]=evalexpo(l); x[2]=0; return;
268: }
269: if (s<0) { x[1] = evalsigne(-1); s = -s; }
270: else x[1] = evalsigne(1);
271: l=bfffo(s); x[1] |= evalexpo((BITS_IN_LONG-1)-l);
272: x[2] = s<<l; for (l=3; l<lg(x); l++) x[l]=0;
273: }
274:
275: INLINE void
276: mpaff(GEN x, GEN y)
277: {
278: if (typ(x)==t_INT)
279: { if (typ(y)==t_INT) affii(x,y); else affir(x,y); }
280: else
281: { if (typ(y)==t_INT) affri(x,y); else affrr(x,y); }
282: }
283:
284: INLINE GEN
285: shiftr(GEN x, long n)
286: {
287: const long e = evalexpo(expo(x)+n);
288: const GEN y = rcopy(x);
289:
290: if (e & ~EXPOBITS) err(shier2);
291: y[1] = (y[1]&~EXPOBITS) | e; return y;
292: }
293:
294: INLINE int
295: cmpir(GEN x, GEN y)
296: {
297: long av;
298: GEN z;
299:
300: if (!signe(x)) return -signe(y);
301: av=avma; z=cgetr(lg(y)); affir(x,z); avma=av;
302: return cmprr(z,y); /* cmprr does no memory adjustment */
303: }
304:
305: INLINE int
306: cmpsr(long x, GEN y)
307: {
308: long av;
309: GEN z;
310:
311: if (!x) return -signe(y);
312: av=avma; z=cgetr(3); affsr(x,z); avma=av;
313: return cmprr(z,y);
314: }
315:
316: INLINE void
317: addssz(long x, long y, GEN z)
318: {
319: if (typ(z)==t_INT) gops2ssz(addss,x,y,z);
320: else
321: {
322: const long av=avma;
323: const GEN p1=cgetr(lg(z));
324:
325: affsr(x,p1); affrr(addrs(p1,y),z); avma=av;
326: }
327: }
328:
329: INLINE GEN
330: subii(GEN x, GEN y)
331: {
332: const long s=signe(y);
333: GEN z;
334:
335: if (x==y) return gzero;
336: setsigne(y,-s); z=addii(x,y);
337: setsigne(y, s); return z;
338: }
339:
340: INLINE GEN
341: subrr(GEN x, GEN y)
342: {
343: const long s=signe(y);
344: GEN z;
345:
346: if (x==y) return realzero(lg(x)+2);
347: setsigne(y,-s); z=addrr(x,y);
348: setsigne(y, s); return z;
349: }
350:
351: INLINE GEN
352: subir(GEN x, GEN y)
353: {
354: const long s=signe(y);
355: GEN z;
356:
357: setsigne(y,-s); z=addir(x,y);
358: setsigne(y, s); return z;
359: }
360:
361: INLINE GEN
362: subri(GEN x, GEN y)
363: {
364: const long s=signe(y);
365: GEN z;
366:
367: setsigne(y,-s); z=addir(y,x);
368: setsigne(y, s); return z;
369: }
370:
371: INLINE GEN
372: subsi(long x, GEN y)
373: {
374: const long s=signe(y);
375: GEN z;
376:
377: setsigne(y,-s); z=addsi(x,y);
378: setsigne(y, s); return z;
379: }
380:
381: INLINE GEN
382: subsr(long x, GEN y)
383: {
384: const long s=signe(y);
385: GEN z;
386:
387: setsigne(y,-s); z=addsr(x,y);
388: setsigne(y, s); return z;
389: }
390:
391: INLINE void
392: mulssz(long x, long y, GEN z)
393: {
394: if (typ(z)==t_INT) gops2ssz(mulss,x,y,z);
395: else
396: {
397: const long av=avma;
398: const GEN p1=cgetr(lg(z));
399:
400: affsr(x,p1); mpaff(mulsr(y,p1),z); avma=av;
401: }
402: }
403:
404: INLINE void
405: mulsii(long x, GEN y, GEN z)
406: {
407: const long av=avma;
408: affii(mulsi(x,y),z); avma=av;
409: }
410:
411: INLINE void
412: addsii(long x, GEN y, GEN z)
413: {
414: const long av=avma;
415: affii(addsi(x,y),z); avma=av;
416: }
417:
418: INLINE long
419: divisii(GEN x, long y, GEN z)
420: {
421: const long av=avma;
422: affii(divis(x,y),z); avma=av; return hiremainder;
423: }
424:
425: INLINE long
426: vali(GEN x)
427: {
428: long lx,i;
429:
430: if (!signe(x)) return -1;
431: i = lx = lgefint(x)-1; while (!x[i]) i--;
432: return ((lx-i)<<TWOPOTBITS_IN_LONG) + vals(x[i]);
433: }
434:
435: INLINE GEN
436: divss(long x, long y)
437: {
438: long p1;
439: LOCAL_HIREMAINDER;
440:
441: if (!y) err(diver1);
442: hiremainder=0; p1 = divll((ulong)labs(x),(ulong)labs(y));
443: if (x<0) { hiremainder = -((long)hiremainder); p1 = -p1; }
444: if (y<0) p1 = -p1;
445: SAVE_HIREMAINDER; return stoi(p1);
446: }
447:
448: INLINE GEN
449: dvmdss(long x, long y, GEN *z)
450: {
451: const GEN p1=divss(x,y);
452: *z = stoi(hiremainder); return p1;
453: }
454:
455: INLINE GEN
456: dvmdsi(long x, GEN y, GEN *z)
457: {
458: const GEN p1=divsi(x,y);
459: *z = stoi(hiremainder); return p1;
460: }
461:
462: INLINE GEN
463: dvmdis(GEN x, long y, GEN *z)
464: {
465: const GEN p1=divis(x,y);
466: *z=stoi(hiremainder); return p1;
467: }
468:
469: INLINE void
470: dvmdssz(long x, long y, GEN z, GEN t)
471: {
472: const long av=avma;
473: const GEN p1=divss(x,y);
474:
475: affsi(hiremainder,t); mpaff(p1,z); avma=av;
476: }
477:
478: INLINE void
479: dvmdsiz(long x, GEN y, GEN z, GEN t)
480: {
481: const long av=avma;
482: const GEN p1=divsi(x,y);
483:
484: affsi(hiremainder,t); mpaff(p1,z); avma=av;
485: }
486:
487: INLINE void
488: dvmdisz(GEN x, long y, GEN z, GEN t)
489: {
490: const long av=avma;
491: const GEN p1=divis(x,y);
492:
493: affsi(hiremainder,t); mpaff(p1,z); avma=av;
494: }
495:
496: INLINE void
497: dvmdiiz(GEN x, GEN y, GEN z, GEN t)
498: {
499: const long av=avma;
500: GEN p;
501:
502: mpaff(dvmdii(x,y,&p),z); mpaff(p,t); avma=av;
503: }
504:
505: INLINE GEN
506: modis(GEN x, long y)
507: {
508: return stoi(smodis(x,y));
509: }
510:
511: INLINE GEN
512: ressi(long x, GEN y)
513: {
514: const long av=avma;
515: divsi(x,y); avma=av; return stoi(hiremainder);
516: }
517:
518: INLINE GEN
519: resis(GEN x, long y)
520: {
521: const long av=avma;
522: divis(x,y); avma=av; return stoi(hiremainder);
523: }
524:
525: INLINE void
526: divisz(GEN x, long y, GEN z)
527: {
528: if (typ(z)==t_INT) gops2gsz(divis,x,y,z);
529: else
530: {
531: const long av=avma;
532: const GEN p1=cgetr(lg(z));
533:
534: affir(x,p1); affrr(divrs(p1,y),z); avma=av;
535: }
536: }
537:
538: INLINE void
539: divsiz(long x, GEN y, GEN z)
540: {
541: const long av=avma;
542:
543: if (typ(z)==t_INT) gaffect(divsi(x,y),z);
544: else
545: {
546: const long lz=lg(z);
547: const GEN p1=cgetr(lz), p2=cgetr(lz);
548:
549: affsr(x,p1); affir(y,p2);
550: affrr(divrr(p1,p2),z);
551: }
552: avma=av;
553: }
554:
555: INLINE void
556: divssz(long x, long y, GEN z)
557: {
558: const long av=avma;
559:
560: if (typ(z)==t_INT) gaffect(divss(x,y),z);
561: else
562: {
563: const GEN p1=cgetr(lg(z));
564:
565: affsr(x,p1); affrr(divrs(p1,y),z);
566: }
567: avma=av;
568: }
569:
570: INLINE void
571: divrrz(GEN x, GEN y, GEN z)
572: {
573: const long av=avma;
574: mpaff(divrr(x,y),z); avma=av;
575: }
576:
577: INLINE void
578: resiiz(GEN x, GEN y, GEN z)
579: {
580: const long av=avma;
581: affii(resii(x,y),z); avma=av;
582: }
583:
584: INLINE int
585: divise(GEN x, GEN y)
586: {
587: const long av=avma;
588: const GEN p1=resii(x,y);
589: avma=av; return p1 == gzero;
590: }
591:
592: INLINE int
593: mpcmp(GEN x, GEN y)
594: {
595: if (typ(x)==t_INT)
596: return (typ(y)==t_INT) ? cmpii(x,y) : cmpir(x,y);
597: return (typ(y)==t_INT) ? -cmpir(y,x) : cmprr(x,y);
598: }
599:
600: INLINE GEN
601: mpadd(GEN x, GEN y)
602: {
603: if (typ(x)==t_INT)
604: return (typ(y)==t_INT) ? addii(x,y) : addir(x,y);
605: return (typ(y)==t_INT) ? addir(y,x) : addrr(x,y);
606: }
607:
608: INLINE GEN
609: mpsub(GEN x, GEN y)
610: {
611: if (typ(x)==t_INT)
612: return (typ(y)==t_INT) ? subii(x,y) : subir(x,y);
613: return (typ(y)==t_INT) ? subri(x,y) : subrr(x,y);
614: }
615:
616: INLINE GEN
617: mpmul(GEN x, GEN y)
618: {
619: if (typ(x)==t_INT)
620: return (typ(y)==t_INT) ? mulii(x,y) : mulir(x,y);
621: return (typ(y)==t_INT) ? mulir(y,x) : mulrr(x,y);
622: }
623:
624: INLINE GEN
625: mpdiv(GEN x, GEN y)
626: {
627: if (typ(x)==t_INT)
628: return (typ(y)==t_INT) ? divii(x,y) : divir(x,y);
629: return (typ(y)==t_INT) ? divri(x,y) : divrr(x,y);
630: }
631:
632: INLINE int
633: mpdivis(GEN x, GEN y, GEN z)
634: {
635: const long av=avma;
636: GEN p2;
637: const GEN p1=dvmdii(x,y,&p2);
638:
639: if (signe(p2)) { avma=av; return 0; }
640: affii(p1,z); avma=av; return 1;
641: }
642:
643: /* THE FOLLOWING ONES ARE NOT IN mp.s */
644: # endif /* !defined(__M68K__) */
645:
646: INLINE double
647: gtodouble(GEN x)
648: {
649: static long reel4[4]={ evaltyp(t_REAL) | m_evallg(4),0,0,0 };
650:
651: if (typ(x)==t_REAL) return rtodbl(x);
652: gaffect(x,(GEN)reel4); return rtodbl((GEN)reel4);
653: }
654:
655: INLINE long
656: addssmod(long a, long b, long p)
657: {
658: ulong res = a + b;
659: return (res >= (ulong)p) ? res - p : res;
660: }
661:
662: INLINE long
663: subssmod(long a, long b, long p)
664: {
665: long res = a - b;
666: return (res >= 0) ? res : res + p;
667: }
668:
669: INLINE long
670: mulssmod(ulong a, ulong b, ulong c)
671: {
672: LOCAL_HIREMAINDER;
673: {
674: register ulong x = mulll(a,b);
675:
676: /* alter the doubleword by a multiple of c: */
677: if (hiremainder>=c) hiremainder %= c;
678: (void)divll(x,c);
679: }
680: return hiremainder;
681: }
682:
683: INLINE long
684: divssmod(long a, long b, long p)
685: {
686: long v1 = 0, v2 = 1, v3, r, oldp = p;
687:
688: while (b > 1)
689: {
690: v3 = v1 - (p / b) * v2; v1 = v2; v2 = v3;
691: r = p % b; p = b; b = r;
692: }
693:
694: if (v2 < 0) v2 += oldp;
695: return mulssmod(a, v2, oldp);
696: }
697:
698: INLINE long
699: expi(GEN x)
700: {
701: const long lx=lgefint(x);
702: return lx==2? -HIGHEXPOBIT: bit_accuracy(lx)-bfffo(x[2])-1;
703: }
704:
705: #endif
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to level1.h CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / pari / src / kernel / none