From cce735e189bfcfd4a211fd856bc1850dce9b9d8c Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sun, 16 Sep 2012 22:46:14 -0700
Subject: * arith.c (logand, logior, logxor): Bugfix: result needs to be
 normalized, otherwise we end up with fixnum-range bignums. (comp_clamp): New
 function. (logcomp): Changed to two argument form. If second argument is
 present (not nil) then call comp_clamp.

* eval.c (eval_init): Change registration of logcomp to allow
optional argument.

* lib.h (logcomp): Declaration updated.

* mpi-patches/add-bitops:  New mp_clamp_comp function implemented.
---
 arith.c | 51 +++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 47 insertions(+), 4 deletions(-)

(limited to 'arith.c')

diff --git a/arith.c b/arith.c
index 0202f121..ff15daff 100644
--- a/arith.c
+++ b/arith.c
@@ -1520,7 +1520,7 @@ val logand(val a, val b)
     c = make_bignum();
     if (mp_and(mp(a), mp(b), mp(c)) != MP_OKAY)
       goto bad;
-    return c;
+    return normalize(c);
   default:
     uw_throwf(error_s, lit("logand: non-integral operands ~s ~s"), a, b, nao);
   }
@@ -1561,7 +1561,7 @@ val logior(val a, val b)
     c = make_bignum();
     if (mp_or(mp(a), mp(b), mp(c)) != MP_OKAY)
       goto bad;
-    return c;
+    return normalize(c);
   default:
     uw_throwf(error_s, lit("logior: non-integral operands ~s ~s"), a, b, nao);
   }
@@ -1602,7 +1602,7 @@ val logxor(val a, val b)
     c = make_bignum();
     if (mp_xor(mp(a), mp(b), mp(c)) != MP_OKAY)
       goto bad;
-    return c;
+    return normalize(c);
   default:
     uw_throwf(error_s, lit("logxor: non-integral operands ~s ~s"), a, b, nao);
   }
@@ -1611,9 +1611,52 @@ bad:
   uw_throwf(error_s, lit("logxor: operation failed on ~s ~s"), a, b, nao);
 }
 
-val logcomp(val a)
+static val comp_clamp(val a, val bits)
 {
+  cnum an, bn;
   val b;
+  const cnum num_mask = (NUM_MAX << 1) | 1;
+  const int num_bits = CHAR_BIT * sizeof (cnum) - 2;
+
+  if (!fixnump(bits))
+    goto bad2;
+
+  bn = c_num(bits);
+
+  switch (type(a)) {
+  case NUM:
+    an = c_num(a);
+    if (bn <= num_bits) {
+      cnum mask = num_mask >> (num_bits - bn);
+      return num_fast((an & mask) ^ mask);
+    }
+    a = bignum(an);
+    /* fallthrough */
+  case BGNUM:
+    b = make_bignum();
+    if (mp_clamp_comp(mp(a), mp(b), bn) != MP_OKAY)
+      goto bad;
+    return normalize(b);
+  default:
+    goto bad3;
+  }
+
+bad:
+  uw_throwf(error_s, lit("logcomp: operation failed on ~s"), a, nao);
+
+bad2:
+  uw_throwf(error_s, lit("logcomp: bits value ~s is not a fixnum"), bits, nao);
+
+bad3:
+  uw_throwf(error_s, lit("logcomp: non-integral operand ~s"), a, nao);
+}
+
+val logcomp(val a, val bits)
+{
+  val b;
+
+  if (bits)
+    return comp_clamp(a, bits);
 
   switch (type(a)) {
   case NUM:
-- 
cgit v1.2.3