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