[PATCH CVS] 2-adic shift

[Ilya Zakharevich <ilya@math.ohio-state.edu>]

This adds a flag to shift() which changes the behaviour for
right-shift of negative numbers: instead of preserving-but-ignoring the
sign, the shift is performed as if modulo big power of 2.

This enables compatibility of shift() with 2-complement semantic of
negative numbers.

Enjoy,
Ilya

P.S.  Tested with

  shiftr(x,n)=if(x<0&&n<0,shift(x+1,n)-1,shift(x,n))
  lim=66
  for(s=0,lim,print1(".");forvec(X=[[0,lim],[0,lim]],n=2^X[2]-2^X[1];r=shift(-n,-s,1);r1=shiftr(-n,-s);if(r==r1,,print("shift(-"n",-"s",1) = "r" != "r1)),1))


Index: src/basemath/gen3.c
===================================================================
RCS file: /home/megrez/cvsroot/pari/src/basemath/gen3.c,v
retrieving revision 1.31
diff -p -u -r1.31 gen3.c
--- src/basemath/gen3.c	2001/09/05 17:33:31	1.31
+++ src/basemath/gen3.c	2001/09/29 15:43:38
@@ -890,13 +890,19 @@ gdivround(GEN x, GEN y)
 GEN
 gshift(GEN x, long n)
 {
+    return gshift3(x, n, 0);
+}
+
+GEN
+gshift3(GEN x, long n, long flag)
+{
   long i,l,lx, tx = typ(x);
   GEN y;
 
   switch(tx)
   {
     case t_INT:
-      return shifti(x,n);
+      return shifti3(x,n,flag);
     case t_REAL:
       return shiftr(x,n);
 
Index: src/headers/paridecl.h
===================================================================
RCS file: /home/megrez/cvsroot/pari/src/headers/paridecl.h,v
retrieving revision 1.99
diff -p -u -r1.99 paridecl.h
--- src/headers/paridecl.h	2001/09/05 17:33:32	1.99
+++ src/headers/paridecl.h	2001/09/29 15:43:41
@@ -895,6 +895,7 @@ GEN     greal(GEN x);
 GEN     grndtoi(GEN x, long *e);
 GEN     ground(GEN x);
 GEN     gshift(GEN x, long n);
+GEN     gshift3(GEN x, long n, long flag);
 GEN     gsubst(GEN x, long v, GEN y);
 GEN     gtopoly(GEN x, long v);
 GEN     gtopolyrev(GEN x, long v);
@@ -1029,6 +1030,7 @@ int     ratlift(GEN x, GEN m, GEN *a, GE
 GEN     resss(long x, long y);
 double  rtodbl(GEN x);
 GEN     shifti(GEN x, long n);
+GEN     shifti3(GEN x, long n, long flag);
 long    smodsi(long x, GEN y);
 GEN     sqri(GEN x);
 GEN     truedvmdii(GEN x, GEN y, GEN *z);
Index: src/kernel/none/mp.c
===================================================================
RCS file: /home/megrez/cvsroot/pari/src/kernel/none/mp.c,v
retrieving revision 1.46
diff -p -u -r1.46 mp.c
--- src/kernel/none/mp.c	2001/08/28 17:55:36	1.46
+++ src/kernel/none/mp.c	2001/09/29 15:43:43
@@ -259,6 +259,12 @@ affrr(GEN x, GEN y)
 GEN
 shifti(GEN x, long n)
 {
+    return shifti3(x, n, 0);
+}
+
+GEN
+shifti3(GEN x, long n, long flag)
+{
   const long s=signe(x);
   long lx,ly,i,m;
   GEN y;
@@ -285,19 +291,50 @@ shifti(GEN x, long n)
   }
   else
   {
+    long lyorig;
+
     n = -n;
-    ly = lx - (n>>TWOPOTBITS_IN_LONG);
-    if (ly<3) return gzero;
+    ly = lyorig = lx - (n>>TWOPOTBITS_IN_LONG);
+    if (ly<3)
+	return flag ? stoi(-1) : gzero;
     y = new_chunk(ly);
     m = n & (BITS_IN_LONG-1);
-    if (!m) for (i=2; i<ly; i++) y[i]=x[i];
-    else
-    {
+    if (m) {
       shift_right(y,x, 2,ly, 0,m);
       if (y[2] == 0)
       {
-        if (ly==3) { avma = (long)(y+3); return gzero; }
+        if (ly==3) { avma = (long)(y+3); return flag ? stoi(-1) : gzero; }
         ly--; avma = (long)(++y);
+      }
+    } else {
+      for (i=2; i<ly; i++) y[i]=x[i]; 
+    }
+    /* With FLAG: round up instead of rounding down */
+    if (flag) {				/* Check low bits of x */
+      i = lx;
+      flag = 0;
+      while (--i >= lyorig) {
+	if (x[i]) {
+	  flag = 1;			/* Need to increment y by 1 */
+	  break;
+	}
+      }
+      if (!flag && m)
+	flag = x[lyorig - 1] & ((1<<m) - 1);
+    }
+    if (flag) {				/* Increment i */
+      i = ly;
+      while (1) {
+	if (--i < 2) {			/* Need to extend y on the left */
+	  if (avma <= bot)
+	    err(errpile);
+	  avma = (long)(--y); ly++;
+	  y[2] = 1;
+	  break;
+	}
+	if (++y[i])
+	  break;
+	/* Now we need to propagate the bit into the next longword... */
       }
     }
   }
Index: src/language/helpmsg.c
===================================================================
RCS file: /home/megrez/cvsroot/pari/src/language/helpmsg.c,v
retrieving revision 1.26
diff -p -u -r1.26 helpmsg.c
--- src/language/helpmsg.c	2001/04/07 19:43:57	1.26
+++ src/language/helpmsg.c	2001/09/29 15:43:44
@@ -421,7 +421,7 @@ char *helpmessages_basic[]={
   "setrand(n): reset the seed of the random number generator to n",
   "setsearch(x,y,{flag=0}): looks if y belongs to the set x. If flag is 0 or omitted, returns 0 if it is not, otherwise returns the index j such that y==x[j]. If flag is non-zero, return 0 if y belongs to x, otherwise the index j where it should be inserted",
   "setunion(x,y): union of the sets x and y",
-  "shift(x,n): shift x left n bits if n>=0, right -n bits if n<0",
+  "shift(x,n,{flag=0}): shift x left n bits if n>=0, right -n bits if n<0. If flag is true and n is negative, will treat negative integer x as if modulo big power of 2, otherwise sign of x is ignored but preserved",
   "shiftmul(x,n): multiply x by 2^n (n>=0 or n<0)",
   "sigma(x,{k=1}): sum of the k-th powers of the divisors of x. k is optional and if omitted is assumed to be equal to 1",
   "sign(x): sign of x, of type integer, real or fraction",
Index: src/language/init.c
===================================================================
RCS file: /home/megrez/cvsroot/pari/src/language/init.c,v
retrieving revision 1.89
diff -p -u -r1.89 init.c
--- src/language/init.c	2001/08/26 13:46:34	1.89
+++ src/language/init.c	2001/09/29 15:43:45
@@ -2122,7 +2122,7 @@ entree functions_basic[]={
 {"setrand",99,(void*)setrand,11,"lL"},
 {"setsearch",99,(void*)setsearch,8,"lGGD0,L,"},
 {"setunion",2,(void*)setunion,8,"GG"},
-{"shift",99,(void*)gshift,1,"GL"},
+{"shift",99,(void*)gshift3,1,"GLD0,L,"},
 {"shiftmul",99,(void*)gmul2n,1,"GL"},
 {"sigma",99,(void*)gsumdivk,4,"GD1,L,"},
 {"sign",10,(void*)gsigne,1,"lG"},