home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 2 / RISC_DISC_2.iso / pd_share / program / code / pari / other / version68k < prev    next >
Encoding:
Text File  |  1991-11-28  |  3.9 KB  |  193 lines
  1. #include "genpari.h"
  2.  
  3. void printversion()
  4. {
  5.   pariputs("             GP/PARI CALCULATOR Version 1.36\n");
  6.   pariputs("                      (68020 version)\n");
  7. }
  8.  
  9. ulong overflow,hiremainder;
  10.  
  11. int addll(x,y)
  12.      int x,y;
  13. {
  14.   int z;
  15.  
  16.   z=x+y;
  17.   if((x>=0)&&(y>=0)) {overflow=0;return z;}
  18.   if((x<0)&&(y<0)) {overflow=1;return z;}
  19.   overflow=(z>=0)?1:0; return z;
  20. }
  21.  
  22. int addllx(x,y)
  23.      int x,y;
  24. {
  25.   int z;
  26.  
  27.   z=x+y+overflow;
  28.   if((x>=0)&&(y>=0)) {overflow=0;return z;}
  29.   if((x<0)&&(y<0)) {overflow=1;return z;}
  30.   overflow=(z>=0)?1:0; return z;
  31. }
  32.  
  33. int subll(x,y)
  34.      int x,y;
  35. {
  36.   int z;
  37.  
  38.   z=x-y;
  39.   if((x>=0)&&(y<0)) {overflow=1;return z;}
  40.   if((x<0)&&(y>=0)) {overflow=0;return z;}
  41.   overflow=(z>=0)?0:1; return z;
  42. }
  43.  
  44. int subllx(x,y)
  45.      int x,y;
  46. {
  47.   int z;
  48.  
  49.   z=x-y-overflow;
  50.   if((x>=0)&&(y<0)) {overflow=1;return z;}
  51.   if((x<0)&&(y>=0)) {overflow=0;return z;}
  52.   overflow=(z>=0)?0:1; return z;
  53. }
  54.  
  55. int shiftl(x,y)
  56.      ulong x,y;
  57. {
  58.   hiremainder=x>>(32-y);return (x<<y);
  59. }
  60.  
  61. int shiftlr(x,y)
  62.      ulong x,y;
  63. {
  64.   hiremainder=x<<(32-y);return (x>>y);
  65. }
  66.  
  67. int bfffo(x)
  68.      ulong x;
  69. {
  70.   int sc;
  71.   static int tabshi[16]={4,3,2,2,1,1,1,1,0,0,0,0,0,0,0,0};
  72.  
  73.   if(x&(0xffff0000)) sc=0;else {sc=16;x<<=16;}
  74.   if(!(x&(0xff000000))) {sc+=8;x<<=8;}
  75.   if(x&(0xf0000000)) x>>=28;else {sc+=4;x>>=24;}
  76.   sc+=tabshi[x];return sc;
  77. }
  78.  
  79. int mulll(x,y)
  80.      ulong x,y;
  81. {
  82.   ulong xlo,xhi,ylo,yhi;
  83.   ulong z;
  84.  
  85.   xlo=x&65535;xhi=x>>16;ylo=y&65535;yhi=y>>16;
  86.   z=addll(xlo*yhi,xhi*ylo);
  87.   hiremainder=(overflow)?xhi*yhi+65536+(z>>16):xhi*yhi+(z>>16);
  88.   z=addll(xlo*ylo,(z<<16));hiremainder+=overflow;
  89.   return z;
  90. }
  91.  
  92. int addmul(x,y)
  93.      ulong x,y;
  94. {
  95.   ulong xlo,xhi,ylo,yhi;
  96.   ulong z,z2;
  97.  
  98.   xlo=x&65535;xhi=x>>16;ylo=y&65535;yhi=y>>16;
  99.   z=addll(xlo*yhi,xhi*ylo);
  100.   z2=(overflow)?xhi*yhi+65536+(z>>16):xhi*yhi+(z>>16);
  101.   z=addll(xlo*ylo,(z<<16));z2+=overflow;
  102.   z=addll(z,hiremainder);hiremainder=z2+overflow;
  103.   return z;
  104. }
  105.  
  106. int divll(x,y)
  107.      ulong x,y;
  108. {
  109. #define HIBIT 0x80000000
  110. #define HIMASK 0xffff0000
  111. #define LOMASK 0xffff
  112. #define HIWORD(a) (a >> 16)
  113. /* si le compilateur est bugge, il faut mettre (a >> 16) & LOMASK) */
  114. #define LOWORD(a) (a & LOMASK)
  115. #define GLUE(hi, lo) ((hi << 16) + lo)
  116. #define SPLIT(a, b, c) b = HIWORD(a); c = LOWORD(a)
  117.  
  118.     ulong v1, v2, u3, u4, q1, q2, aux, aux1, aux2;
  119.     int k;
  120.     
  121.     for(k = 0; !(y & HIBIT); k++)
  122.         {
  123.             hiremainder <<= 1;
  124.             if (x & HIBIT) hiremainder++;
  125.             x <<= 1;
  126.             y <<= 1;
  127.         }
  128.         
  129.     SPLIT(y, v1, v2);
  130.     SPLIT(x, u3, u4);
  131.     
  132.     q1 = hiremainder / v1; if (q1 & HIMASK) q1 = LOMASK;
  133.     hiremainder -= q1 * v1;
  134.     aux = v2 * q1;
  135. again:
  136.     SPLIT(aux, aux1, aux2);
  137.     if (aux2 > u3) aux1++;
  138.     if (aux1 > hiremainder) {q1--; hiremainder += v1; aux -= v2; goto again;}
  139.     u3 -= aux2;
  140.     hiremainder -= aux1;
  141.     hiremainder <<= 16; hiremainder += u3 & LOMASK;
  142.     
  143.     q2 = hiremainder / v1; if (q2 & HIMASK) q2 = LOMASK;
  144.     hiremainder -= q2 * v1;
  145.     aux = v2 * q2;
  146. again2:
  147.     SPLIT(aux, aux1, aux2);
  148.     if (aux2 > u4) aux1++;
  149.     if (aux1 > hiremainder) {q2--; hiremainder += v1; aux -= v2; goto again2;}
  150.     u4 -= aux2;
  151.     hiremainder -= aux1;
  152.     hiremainder <<= 16; hiremainder += u4 & LOMASK;
  153.     hiremainder >>= k;
  154.     return GLUE(q1, q2);
  155. }
  156.  
  157. /* The following program is a C translation of the gerepile
  158. program of mp.s and is intended solely for debugging. In normal
  159. use, it is never called by PARI/GP */
  160.  
  161. GEN gerepilc(l,p,q)
  162.     GEN l,p,q;
  163.  
  164. {
  165.   long av,declg,tl;
  166.   GEN ll,pp,l1,l2,l3;
  167.  
  168.   declg=(long)l-(long)p;if(declg<=0) return q;
  169.   for(ll=l,pp=p;pp>(GEN)avma;) *--ll= *--pp;
  170.   av=(long)ll;
  171.   while((ll<l)||((ll==l)&&(long)q))
  172.   {
  173.     l2=ll+lontyp[tl=typ(ll)];
  174.     if(tl==10) {l3=ll+lgef(ll);ll+=lg(ll);if(l3>ll) l3=l2;}
  175.     else {ll+=lg(ll);l3=ll;} 
  176.     for(;l2<l3;l2++) 
  177.       {
  178.     l1=(GEN)(*l2);
  179.     if((l1<l)&&(l1>=(GEN)avma))
  180.       {
  181.         if(l1<p) *l2+=declg;
  182.         else
  183.           if(ll<=l) err(gerper);
  184.       }
  185.       }
  186.   }
  187.   if((!((long)q))||((q<p)&&(q>=(GEN)avma)))
  188.   {
  189.     avma=av;return q+(declg>>2);
  190.   }
  191.   else {avma=av;return q;}
  192. }
  193.