* 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.

5 files changed, 111 insertions, 10 deletions

diff --git a/ChangeLog b/ChangeLog
index c53a774d..7fea1ebb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,20 @@
 2012-09-16  Kaz Kylheku  <kaz@kylheku.com>
 
+	* 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.
+
+2012-09-16  Kaz Kylheku  <kaz@kylheku.com>
+
 	Adding complementing function.
 
 	* arith.c (logcomp): New function.
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:
diff --git a/eval.c b/eval.c
index e075555d..4050a2ea 100644
--- a/eval.c
+++ b/eval.c
@@ -2234,7 +2234,7 @@ void eval_init(void)
   reg_fun(intern(lit("logand"), user_package), func_n2(logand));
   reg_fun(intern(lit("logior"), user_package), func_n2(logior));
   reg_fun(intern(lit("logxor"), user_package), func_n2(logxor));
-  reg_fun(intern(lit("logcomp"), user_package), func_n1(logcomp));
+  reg_fun(intern(lit("logcomp"), user_package), func_n2o(logcomp, 1));
 
   reg_fun(intern(lit("regex-compile"), user_package), func_n1(regex_compile));
   reg_fun(intern(lit("regexp"), user_package), func_n1(regexp));
diff --git a/lib.h b/lib.h
index 331c2fb4..91cca628 100644
--- a/lib.h
+++ b/lib.h
@@ -474,7 +474,7 @@ val expo(val);
 val logand(val, val);
 val logior(val, val);
 val logxor(val, val);
-val logcomp(val);
+val logcomp(val, val);
 val string_own(wchar_t *str);
 val string(const wchar_t *str);
 val string_utf8(const char *str);
diff --git a/mpi-patches/add-bitops b/mpi-patches/add-bitops
index 7abb0306..e401c334 100644
--- a/mpi-patches/add-bitops
+++ b/mpi-patches/add-bitops
@@ -1,7 +1,7 @@
 Index: mpi-1.8.6/mpi.c
 ===================================================================
 --- mpi-1.8.6.orig/mpi.c	2012-09-16 10:50:08.270639006 -0700
-+++ mpi-1.8.6/mpi.c	2012-09-16 20:01:35.403688256 -0700
++++ mpi-1.8.6/mpi.c	2012-09-16 22:24:49.194978256 -0700
 @@ -16,6 +16,9 @@
  #include <ctype.h>
  #include <math.h>
@@ -12,7 +12,7 @@ Index: mpi-1.8.6/mpi.c
  typedef unsigned char mem_t;
  extern mem_t *chk_malloc(size_t size);
  extern mem_t *chk_calloc(size_t n, size_t size);
-@@ -2330,6 +2333,275 @@
+@@ -2330,6 +2333,317 @@
  
  /* }}} */
  
@@ -285,13 +285,55 @@ Index: mpi-1.8.6/mpi.c
 +  return MP_OKAY;
 +}
 +
++mp_err mp_clamp_comp(mp_int *a, mp_int *b, mp_digit bits)
++{
++  mp_err res;
++  mp_size ix, dig = bits / DIGIT_BIT, rembits = bits % DIGIT_BIT;
++  int extra = (rembits != 0);
++  mp_digit *pa, *pb;
++  mp_int tmp;
++
++  ARGCHK(a != NULL && b != NULL, MP_BADARG);
++
++  if (a != b)
++    res = mp_init_size(b, dig + extra);
++  else
++    res = s_mp_pad(b, dig + extra);
++
++  if (res != MP_OKAY)
++    return res;
++
++  if (ISNEG(a)) {
++    mp_init(&tmp);
++    if ((res = mp_2comp(a, &tmp, dig + extra)) != MP_OKAY)
++	return res;
++    a = &tmp;
++  }
++
++  for (pa = DIGITS(a), pb = DIGITS(b), ix = 0; ix < dig; ix++)
++    pb[ix] = ~pa[ix];
++
++  if (rembits) {
++    mp_digit mask = (MP_DIGIT_MAX >> (DIGIT_BIT - rembits));
++    pb[ix] = (pa[ix] & mask) ^ mask;
++  }
++
++  USED(b) = dig + extra;
++
++  if (ISNEG(a))
++    mp_clear(&tmp);
++
++  s_mp_clamp(b);
++  return MP_OKAY;
++}
++
  mp_err mp_to_double(mp_int *mp, double *d)
  {
    int ix;
 Index: mpi-1.8.6/mpi.h
 ===================================================================
 --- mpi-1.8.6.orig/mpi.h	2012-09-16 10:50:08.046513006 -0700
-+++ mpi-1.8.6/mpi.h	2012-09-16 19:01:51.000595006 -0700
++++ mpi-1.8.6/mpi.h	2012-09-16 21:45:17.713770006 -0700
 @@ -54,6 +54,7 @@
  
  /* Macros for accessing the mp_int internals           */
@@ -300,7 +342,7 @@ Index: mpi-1.8.6/mpi.h
  #define  USED(MP)     ((MP)->used)
  #define  ALLOC(MP)    ((MP)->alloc)
  #define  DIGITS(MP)   ((MP)->dp)
-@@ -187,6 +188,14 @@
+@@ -187,6 +188,15 @@
  #endif /* end MP_NUMTH */
  
  /*------------------------------------------------------------------------*/
@@ -310,6 +352,7 @@ Index: mpi-1.8.6/mpi.h
 +mp_err mp_or(mp_int *a, mp_int *b, mp_int *c);
 +mp_err mp_xor(mp_int *a, mp_int *b, mp_int *c);
 +mp_err mp_comp(mp_int *a, mp_int *b);
++mp_err mp_clamp_comp(mp_int *a, mp_int *b, mp_digit bits);
 +
 +/*------------------------------------------------------------------------*/
  /* Conversions                                                            */