guile/guile-core THANKS libguile/ChangeLog libg...

[Dirk Herrmann]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Dirk Herrmann <address@hidden>  01/01/17 10:15:30

Modified files:
        guile-core     : THANKS 
        guile-core/libguile: ChangeLog __scm.h numbers.c 

Log message:
        * Fixed a couple of bugs with quotient, remainder, bit-extract and 
logand.

CVSWeb URLs:
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/THANKS.diff?r1=1.156&r2=1.157
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/ChangeLog.diff?r1=1.1234&r2=1.1235
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/__scm.h.diff?r1=1.61&r2=1.62
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/numbers.c.diff?r1=1.110&r2=1.111

Patches:
Index: guile/guile-core/THANKS
diff -u guile/guile-core/THANKS:1.156 guile/guile-core/THANKS:1.157
--- guile/guile-core/THANKS:1.156       Tue Jan 16 03:19:35 2001
+++ guile/guile-core/THANKS     Wed Jan 17 10:15:30 2001
@@ -14,6 +14,7 @@
 
     Lars J. Aas
         Ian Bicking
+        Rob Browning
      George Caswell
       Chris Cramer
       I. N. Golubev
Index: guile/guile-core/libguile/ChangeLog
diff -u guile/guile-core/libguile/ChangeLog:1.1234 
guile/guile-core/libguile/ChangeLog:1.1235
--- guile/guile-core/libguile/ChangeLog:1.1234  Tue Jan 16 03:19:35 2001
+++ guile/guile-core/libguile/ChangeLog Wed Jan 17 10:15:30 2001
@@ -1,3 +1,20 @@
+2001-01-17  Dirk Herrmann  <address@hidden>
+
+       * __scm.h (SCM_FIXNUM_BIT):  Added.  The name is chosen in analogy
+       to the names in limits.h.
+
+       * numbers.c (abs_most_negative_fixnum):  Added.
+
+       (scm_quotient, scm_remainder):  Fixed the fixnum-min / (abs
+       fixnum-min) special case.
+
+       (scm_big_and):  Fix for negative first parameter.
+
+       (scm_bit_extract):  Fix for fixnum paramters.
+       Thanks to Rob Browning for the bug report.
+
+       (scm_init_numbers):  Initialize abs_most_negative_fixnum.
+
 2001-01-16  Dirk Herrmann  <address@hidden>
 
        * symbols.c (scm_symbol_bound_p):  Fixed comment.
Index: guile/guile-core/libguile/__scm.h
diff -u guile/guile-core/libguile/__scm.h:1.61 
guile/guile-core/libguile/__scm.h:1.62
--- guile/guile-core/libguile/__scm.h:1.61      Fri Jun 30 10:37:26 2000
+++ guile/guile-core/libguile/__scm.h   Wed Jan 17 10:15:30 2001
@@ -217,6 +217,7 @@
 # else
 #  define SCM_CHAR_CODE_LIMIT 256L
 # endif /* def UCHAR_MAX */
+# define SCM_FIXNUM_BIT (LONG_BIT - 2)
 # define SCM_MOST_POSITIVE_FIXNUM (LONG_MAX>>2)
 # ifdef _UNICOS                        /* Stupid cray bug */
 #  define SCM_MOST_NEGATIVE_FIXNUM ((long)LONG_MIN/4)
@@ -225,6 +226,7 @@
 # endif                                /* UNICOS */
 #else
 # define SCM_CHAR_CODE_LIMIT 256L
+# define SCM_FIXNUM_BIT 30
 # define SCM_MOST_POSITIVE_FIXNUM ((long)((unsigned long)~0L>>3))
 # if (0 != ~0)
 #  define SCM_MOST_NEGATIVE_FIXNUM (-SCM_MOST_POSITIVE_FIXNUM-1)
Index: guile/guile-core/libguile/numbers.c
diff -u guile/guile-core/libguile/numbers.c:1.110 
guile/guile-core/libguile/numbers.c:1.111
--- guile/guile-core/libguile/numbers.c:1.110   Wed Dec 13 16:08:56 2000
+++ guile/guile-core/libguile/numbers.c Wed Jan 17 10:15:30 2001
@@ -96,7 +96,11 @@
 
 
 
+static SCM abs_most_negative_fixnum;
 
+
+
+
 SCM_DEFINE (scm_exact_p, "exact?", 1, 0, 0, 
             (SCM x),
            "Return #t if X is an exact number, #f otherwise.")
@@ -201,7 +205,14 @@
        }
       }
     } else if (SCM_BIGP (y)) {
-      return SCM_INUM0;
+      if (SCM_INUM (x) == SCM_MOST_NEGATIVE_FIXNUM
+         && scm_bigcomp (abs_most_negative_fixnum, y) == 0)
+       {
+         /* Special case:  x == fixnum-min && y == abs (fixnum-min) */
+         return SCM_MAKINUM (-1);
+       }
+      else
+       return SCM_MAKINUM (0);
     } else {
       SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient);
     }
@@ -262,7 +273,14 @@
        return SCM_MAKINUM (z);
       }
     } else if (SCM_BIGP (y)) {
-      return x;
+      if (SCM_INUM (x) == SCM_MOST_NEGATIVE_FIXNUM
+         && scm_bigcomp (abs_most_negative_fixnum, y) == 0)
+       {
+         /* Special case:  x == fixnum-min && y == abs (fixnum-min) */
+         return SCM_MAKINUM (0);
+       }
+      else
+       return x;
     } else {
       SCM_WTA_DISPATCH_2 (g_remainder, x, y, SCM_ARG2, s_remainder);
     }
@@ -654,12 +672,14 @@
       if (!num) return scm_normbig(z);
     }
   }
-  else if (xsgn) do {
-    num += x[i];
-    if (num < 0) {zds[i] &= num + SCM_BIGRAD; num = -1;}
-    else {zds[i] &= ~SCM_BIGLO(num); num = 0;}
-  } while (++i < nx);
-  else do zds[i] = zds[i] & x[i]; while (++i < nx);
+  else if (xsgn) {
+    unsigned long int carry = 1;
+    do {
+      unsigned long int mask = (SCM_BIGDIG) ~x[i] + carry;
+      zds[i] = zds[i] & (SCM_BIGDIG) mask;
+      carry = (mask >= SCM_BIGRAD) ? 1 : 0;
+    } while (++i < nx);
+  } else do zds[i] = zds[i] & x[i]; while (++i < nx);
   return scm_normbig(z);
 }
 
@@ -1181,19 +1201,50 @@
            "@end lisp")
 #define FUNC_NAME s_scm_bit_extract
 {
-  int istart, iend;
+  unsigned long int istart, iend;
   SCM_VALIDATE_INUM_MIN_COPY (2,start,0,istart);
   SCM_VALIDATE_INUM_MIN_COPY (3, end, 0, iend);
   SCM_ASSERT_RANGE (3, end, (iend >= istart));
 
   if (SCM_INUMP (n)) {
-    return SCM_MAKINUM ((SCM_INUM (n) >> istart) & ((1L << (iend - istart)) - 
1));
+    long int in = SCM_INUM (n);
+    unsigned long int bits = iend - istart;
+
+    if (in < 0 && bits >= SCM_FIXNUM_BIT)
+      {
+       /* Since we emulate two's complement encoded numbers, this special
+        * case requires us to produce a result that has more bits than can be
+        * stored in a fixnum.  Thus, we fall back to the more general
+        * algorithm that is used for bignums.  
+        */
+       goto generalcase;
+      }
+
+    if (istart < SCM_FIXNUM_BIT)
+      {
+       in = in >> istart;
+       if (bits < SCM_FIXNUM_BIT)
+         return SCM_MAKINUM (in & ((1L << bits) - 1));
+       else /* we know: in >= 0 */
+         return SCM_MAKINUM (in);
+      }
+    else if (in < 0)
+      {
+       return SCM_MAKINUM (-1L & ((1L << bits) - 1));
+      }
+    else
+      {
+       return SCM_MAKINUM (0);
+      }
   } else if (SCM_BIGP (n)) {
-    SCM num1 = SCM_MAKINUM (1L);
-    SCM num2 = SCM_MAKINUM (2L);
-    SCM bits = SCM_MAKINUM (iend - istart);
-    SCM mask  = scm_difference (scm_integer_expt (num2, bits), num1);
-    return scm_logand (mask, scm_ash (n, SCM_MAKINUM (-istart)));
+  generalcase:
+    {
+      SCM num1 = SCM_MAKINUM (1L);
+      SCM num2 = SCM_MAKINUM (2L);
+      SCM bits = SCM_MAKINUM (iend - istart);
+      SCM mask  = scm_difference (scm_integer_expt (num2, bits), num1);
+      return scm_logand (mask, scm_ash (n, SCM_MAKINUM (-istart)));
+    }
   } else {
     SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
   }
@@ -4353,6 +4404,9 @@
 void
 scm_init_numbers ()
 {
+  abs_most_negative_fixnum = scm_long2big (- SCM_MOST_NEGATIVE_FIXNUM);
+  scm_permanent_object (abs_most_negative_fixnum);
+
   /* It may be possible to tune the performance of some algorithms by using
    * the following constants to avoid the creation of bignums.  Please, before
    * using these values, remember the two rules of program optimization: