Starting work on adding bit operations. The semantics is that

negative integers behave as an "infinite bit two's complement".

* arith.c (logand, logor, logxor): New functions.

* eval.c (eval_init): New intrinsic functions logand, logior, logxor.

* lib.h (logand, logor, logxor): Declared.

* mpi-patches/series: New patch, add-bitops.

* mpi-patches/add-bitops: New file.

6 files changed, 418 insertions, 0 deletions

diff --git a/ChangeLog b/ChangeLog
index 9fee44f5..e74d082c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,20 @@
 2012-09-16  Kaz Kylheku  <kaz@kylheku.com>
 
+	Starting work on adding bit operations. The semantics is that
+	negative integers behave as an "infinite bit two's complement".
+
+	* arith.c (logand, logor, logxor): New functions.
+
+	* eval.c (eval_init): New intrinsic functions logand, logior, logxor.
+
+	* lib.h (logand, logor, logxor): Declared.
+
+	* mpi-patches/series: New patch, add-bitops.
+
+	* mpi-patches/add-bitops: New file.
+
+2012-09-16  Kaz Kylheku  <kaz@kylheku.com>
+
 	* stream.c (vformat): Fix bug in ~x format directive for printing
 	integers in hex. When we use the printf's %x conversion specifiers for
 	fixnums, we get incorrect results when the values are negative, because
diff --git a/arith.c b/arith.c
index 5b57faa1..82189866 100644
--- a/arith.c
+++ b/arith.c
@@ -1488,6 +1488,129 @@ val flo_int(val i)
   }
 }
 
+val logand(val a, val b)
+{
+  val c;
+
+  if (zerop(a) || zerop(b))
+    return zero;
+
+  switch (TYPE_PAIR(type(a), type(b))) {
+  case TYPE_PAIR(NUM, NUM):
+    if (a == b) {
+      return a;
+    } else {
+      cnum ac = c_num(a);
+      cnum bc = c_num(b);
+      return num_fast(ac & bc);
+    }
+  case TYPE_PAIR(BGNUM, NUM):
+    {
+      val tmp = a;
+      a = b;
+      b = tmp;
+    }
+    /* fallthrough */
+  case TYPE_PAIR(NUM, BGNUM):
+    a = bignum(c_num(a));
+    /* fallthrough */
+  case TYPE_PAIR(BGNUM, BGNUM):
+    if (a == b)
+      return a;
+    c = make_bignum();
+    if (mp_and(mp(a), mp(b), mp(c)) != MP_OKAY)
+      goto bad;
+    return c;
+  default:
+    uw_throwf(error_s, lit("logand: non-integral operands ~s ~s"), a, b, nao);
+  }
+
+bad:
+  uw_throwf(error_s, lit("logand: operation failed on ~s ~s"), a, b, nao);
+}
+
+val logior(val a, val b)
+{
+  val c;
+
+  if (zerop(a) && zerop(b))
+    return zero;
+
+  switch (TYPE_PAIR(type(a), type(b))) {
+  case TYPE_PAIR(NUM, NUM):
+    if (a == b) {
+      return a;
+    } else {
+      cnum ac = c_num(a);
+      cnum bc = c_num(b);
+      return num_fast(ac | bc);
+    }
+  case TYPE_PAIR(BGNUM, NUM):
+    {
+      val tmp = a;
+      a = b;
+      b = tmp;
+    }
+    /* fallthrough */
+  case TYPE_PAIR(NUM, BGNUM):
+    a = bignum(c_num(a));
+    /* fallthrough */
+  case TYPE_PAIR(BGNUM, BGNUM):
+    if (a == b)
+      return a;
+    c = make_bignum();
+    if (mp_or(mp(a), mp(b), mp(c)) != MP_OKAY)
+      goto bad;
+    return c;
+  default:
+    uw_throwf(error_s, lit("logior: non-integral operands ~s ~s"), a, b, nao);
+  }
+
+bad:
+  uw_throwf(error_s, lit("logior: operation failed on ~s ~s"), a, b, nao);
+}
+
+val logxor(val a, val b)
+{
+  val c;
+
+  if (zerop(a) && zerop(b))
+    return zero;
+
+  switch (TYPE_PAIR(type(a), type(b))) {
+  case TYPE_PAIR(NUM, NUM):
+    if (a == b) {
+      return a;
+    } else {
+      cnum ac = c_num(a);
+      cnum bc = c_num(b);
+      return num_fast(ac ^ bc);
+    }
+  case TYPE_PAIR(BGNUM, NUM):
+    {
+      val tmp = a;
+      a = b;
+      b = tmp;
+    }
+    /* fallthrough */
+  case TYPE_PAIR(NUM, BGNUM):
+    a = bignum(c_num(a));
+    /* fallthrough */
+  case TYPE_PAIR(BGNUM, BGNUM):
+    if (a == b)
+      return a;
+    c = make_bignum();
+    if (mp_xor(mp(a), mp(b), mp(c)) != MP_OKAY)
+      goto bad;
+    return c;
+  default:
+    uw_throwf(error_s, lit("logxor: non-integral operands ~s ~s"), a, b, nao);
+  }
+
+bad:
+  uw_throwf(error_s, lit("logxor: operation failed on ~s ~s"), a, b, nao);
+}
+
 void arith_init(void)
 {
   mp_init(&NUM_MAX_MP);
diff --git a/eval.c b/eval.c
index ecf44424..786fc0d4 100644
--- a/eval.c
+++ b/eval.c
@@ -2231,6 +2231,9 @@ void eval_init(void)
   reg_fun(intern(lit("/="), user_package), func_n0v(numneqv));
   reg_fun(intern(lit("max"), user_package), func_n1v(maxv));
   reg_fun(intern(lit("min"), user_package), func_n1v(minv));
+  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("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 d454fd29..90975644 100644
--- a/lib.h
+++ b/lib.h
@@ -471,6 +471,9 @@ val acosi(val);
 val atang(val);
 val loga(val);
 val expo(val);
+val logand(val, val);
+val logior(val, val);
+val logxor(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
new file mode 100644
index 00000000..db4611de
--- /dev/null
+++ b/mpi-patches/add-bitops
@@ -0,0 +1,273 @@
+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 13:31:03.146453506 -0700
+@@ -16,6 +16,9 @@
+ #include <ctype.h>
+ #include <math.h>
+ 
++#define MAX(A, B) ((A) > (B) ? (A) : (B))
++#define MIN(A, B) ((A) < (B) ? (A) : (B))
++
+ 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,232 @@
+ 
+ /* }}} */
+ 
++/*
++ * Convert a's bit vector to its two's complement, up to the
++ * number of words that it contains, storing result in b. The numeric value of
++ * this result depends on the size of mpi_digit. This is a building block for
++ * handling negative operands in the bit operations.
++ */
++mp_err mp_2comp(mp_int *a, mp_int *b, mp_size dig)
++{
++  mp_err res;
++  mp_size ix;
++  mp_digit *pa, *pb;
++  mp_word w;
++
++  ARGCHK(a != NULL && b != NULL, MP_BADARG);
++
++  if (a != b) {
++    if ((res = mp_init_size(b, dig)) != MP_OKAY)
++	return res;
++    SIGN(b) = SIGN(a);
++  } else {
++    if((res = s_mp_pad(b, dig)) != MP_OKAY)
++      return res;
++  }
++
++  for (pa = DIGITS(a), pb = DIGITS(b), w = 0, ix = 0; ix < dig; ix++) {
++    w += ~pa[ix] + (mp_word) (ix == 0);
++    pb[ix] = ACCUM(w);
++    w = CARRYOUT(w);
++  }
++
++  USED(b) = dig;
++
++  return MP_OKAY;
++}
++
++mp_err mp_and(mp_int *a, mp_int *b, mp_int *c)
++{
++  mp_err res;
++  mp_size ix, extent = 0;
++  mp_digit *pa, *pb, *pc;
++  mp_int tmp_a, tmp_b;
++
++  ARGCHK(a != NULL && b != NULL && c != NULL, MP_BADARG);
++
++  if (a == b)
++    return mp_copy(a, c);
++
++  if (ISNEG(a)) {
++    mp_init(&tmp_a);
++    extent = USED(b);
++    if ((res = mp_2comp(a, &tmp_a, extent)) != MP_OKAY)
++	return res;
++    a = &tmp_a;
++  }
++
++  if (ISNEG(b)) {
++    mp_init(&tmp_b);
++    extent = USED(a);
++    if ((res = mp_2comp(b, &tmp_b, extent)) != MP_OKAY) {
++	if (ISNEG(a))
++	  mp_clear(&tmp_a);
++	return res;
++    }
++    b = &tmp_b;
++  }
++
++  if (!extent)
++    extent = MIN(USED(a), USED(b));
++
++  if (c != a && c != b) {
++    if ((res = mp_init_size(c, extent)) != MP_OKAY)
++	return res;
++  }
++
++  for (pa = DIGITS(a), pb = DIGITS(b), pc = DIGITS(c), ix = 0;
++	 ix < extent; ix++)
++  {
++    pc[ix] = pa[ix] & pb[ix];
++  }
++
++  USED(c) = extent;
++
++  if (ISNEG(a) && ISNEG(b)) {
++    mp_2comp(c, c, extent);
++    SIGN(c) = MP_NEG;
++  }
++
++  s_mp_clamp(c);
++
++  if (ISNEG(a))
++    mp_clear(&tmp_a);
++
++  if (ISNEG(b))
++    mp_clear(&tmp_b);
++
++  return MP_OKAY;
++}
++
++mp_err mp_or(mp_int *a, mp_int *b, mp_int *c)
++{
++  mp_err res;
++  mp_size ix, extent = 0;
++  mp_digit *pa, *pb, *pc;
++  mp_int tmp_a, tmp_b;
++
++  ARGCHK(a != NULL && b != NULL && c != NULL, MP_BADARG);
++
++  extent = MAX(USED(a), USED(b));
++
++  if (a == b)
++    return mp_copy(a, c);
++
++  if (ISNEG(a)) {
++    mp_init(&tmp_a);
++    if ((res = mp_2comp(a, &tmp_a, extent)) != MP_OKAY)
++	return res;
++    a = &tmp_a;
++  }
++
++  if (ISNEG(b)) {
++    mp_init(&tmp_b);
++    if ((res = mp_2comp(b, &tmp_b, extent)) != MP_OKAY) {
++	if (ISNEG(a))
++	  mp_clear(&tmp_a);
++	return res;
++    }
++    b = &tmp_b;
++  }
++
++
++  if (c != a && c != b)
++    res = mp_init_size(c, extent);
++  else
++    res = s_mp_pad(c, extent);
++
++  if (res != MP_OKAY)
++    return res;
++
++  for (pa = DIGITS(a), pb = DIGITS(b), pc = DIGITS(c), ix = 0;
++	 ix < extent; ix++)
++  {
++    pc[ix] = pa[ix] | pb[ix];
++  }
++
++  USED(c) = extent;
++
++  if (ISNEG(a) || ISNEG(b)) {
++    mp_2comp(c, c, extent);
++    SIGN(c) = MP_NEG;
++  }
++
++  s_mp_clamp(c);
++
++  if (ISNEG(a))
++    mp_clear(&tmp_a);
++
++  if (ISNEG(b))
++    mp_clear(&tmp_b);
++
++  return MP_OKAY;
++}
++
++mp_err mp_xor(mp_int *a, mp_int *b, mp_int *c)
++{
++  mp_err res;
++  mp_size ix, extent = 0;
++  mp_digit *pa, *pb, *pc;
++  mp_int tmp_a, tmp_b;
++
++  ARGCHK(a != NULL && b != NULL && c != NULL, MP_BADARG);
++
++  extent = MAX(USED(a), USED(b)) + 1;
++
++  if (a == b)
++    return mp_copy(a, c);
++
++  if (ISNEG(a)) {
++    mp_init(&tmp_a);
++    if ((res = mp_2comp(a, &tmp_a, extent)) != MP_OKAY)
++	return res;
++    a = &tmp_a;
++  }
++
++  if (ISNEG(b)) {
++    mp_init(&tmp_b);
++    if ((res = mp_2comp(b, &tmp_b, extent)) != MP_OKAY) {
++	if (ISNEG(a))
++	  mp_clear(&tmp_a);
++	return res;
++    }
++    b = &tmp_b;
++  }
++
++
++  if (c != a && c != b)
++    res = mp_init_size(c, extent);
++  else
++    res = s_mp_pad(c, extent);
++
++  if (res != MP_OKAY)
++    return res;
++
++  for (pa = DIGITS(a), pb = DIGITS(b), pc = DIGITS(c), ix = 0;
++	 ix < extent; ix++)
++  {
++    pc[ix] = pa[ix] ^ pb[ix];
++  }
++
++  USED(c) = extent;
++
++  if (ISNEG(a) ^ ISNEG(b)) {
++    mp_2comp(c, c, extent);
++    SIGN(c) = MP_NEG;
++  }
++
++  s_mp_clamp(c);
++
++  if (ISNEG(a))
++    mp_clear(&tmp_a);
++
++  if (ISNEG(b))
++    mp_clear(&tmp_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 13:23:09.824359506 -0700
+@@ -54,6 +54,7 @@
+ 
+ /* Macros for accessing the mp_int internals           */
+ #define  SIGN(MP)     ((MP)->sign)
++#define  ISNEG(MP)    ((MP)->sign == MP_NEG)
+ #define  USED(MP)     ((MP)->used)
+ #define  ALLOC(MP)    ((MP)->alloc)
+ #define  DIGITS(MP)   ((MP)->dp)
+@@ -187,6 +188,13 @@
+ #endif /* end MP_NUMTH */
+ 
+ /*------------------------------------------------------------------------*/
++/* Bit ops                                                                */
++mp_err mp_2comp(mp_int *a, mp_int *b, mp_size dig); /* peculiar semantics */
++mp_err mp_and(mp_int *a, mp_int *b, mp_int *c);
++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);
++
++/*------------------------------------------------------------------------*/
+ /* Conversions                                                            */
+ 
+ mp_err mp_to_double(mp_int *mp, double *d);
diff --git a/mpi-patches/series b/mpi-patches/series
index 08e0f6ee..4d56c94a 100644
--- a/mpi-patches/series
+++ b/mpi-patches/series
@@ -15,3 +15,4 @@ shrink-mpi-int
 faster-square-root
 mpi-to-double
 fix-ctype-warnings
+add-bitops