Annotation of OpenXM_contrib/pari/src/kernel/none/level1.h, Revision 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>