summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2001-01-17 18:15:30 +0000
committerDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2001-01-17 18:15:30 +0000
commitac0c002c62752249db3b3095bf70f3c2d66c229f (patch)
tree7fda1c819e481cbceb5bc05eb6bdd9cdd88968fc
parentdebe0dc24ffb36c0e53c6e48caff1ee5d9ad4eb6 (diff)
downloadguile-ac0c002c62752249db3b3095bf70f3c2d66c229f.tar.gz
* Fixed a couple of bugs with quotient, remainder, bit-extract and logand.
-rw-r--r--THANKS1
-rw-r--r--libguile/ChangeLog17
-rw-r--r--libguile/__scm.h2
-rw-r--r--libguile/numbers.c84
4 files changed, 89 insertions, 15 deletions
diff --git a/THANKS b/THANKS
index e5e9cbbb0..dbabae485 100644
--- a/THANKS
+++ b/THANKS
@@ -14,6 +14,7 @@ For fixes or providing information which led to a fix:
Lars J. Aas
Ian Bicking
+ Rob Browning
George Caswell
Chris Cramer
I. N. Golubev
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 47ee02b89..f8ed2b5a2 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,20 @@
+2001-01-17 Dirk Herrmann <D.Herrmann@tu-bs.de>
+
+ * __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 <D.Herrmann@tu-bs.de>
* symbols.c (scm_symbol_bound_p): Fixed comment.
diff --git a/libguile/__scm.h b/libguile/__scm.h
index 2146ca9ac..7723396bc 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -217,6 +217,7 @@ typedef unsigned long long ulong_long;
# 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 @@ typedef unsigned long long ulong_long;
# 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)
diff --git a/libguile/numbers.c b/libguile/numbers.c
index e72d734a4..362a56514 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -96,6 +96,10 @@ static SCM scm_divbigint (SCM x, long z, int sgn, int mode);
+static SCM abs_most_negative_fixnum;
+
+
+
SCM_DEFINE (scm_exact_p, "exact?", 1, 0, 0,
(SCM x),
@@ -201,7 +205,14 @@ scm_quotient (SCM x, SCM y)
}
}
} 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 @@ scm_remainder (SCM x, SCM y)
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 @@ SCM scm_big_and(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy, int zsgn)
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 @@ SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0,
"@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 @@ scm_num2ulong (SCM num, char *pos, const char *s_caller)
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: