* arith.c (width): New function.

* arith.h (width): Declared.

* eval.c (eval_init): Width registered as intrisinc.

* txr.1: Documented width.

5 files changed, 80 insertions, 0 deletions

diff --git a/ChangeLog b/ChangeLog
index d8be7df6..11d9cf2f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2015-01-27  Kaz Kylheku  <kaz@kylheku.com>
+
+	* arith.c (width): New function.
+
+	* arith.h (width): Declared.
+
+	* eval.c (eval_init): Width registered as intrisinc.
+
+	* txr.1: Documented width.
+
 2015-01-25  Kaz Kylheku  <kaz@kylheku.com>
 
 	* eval.c (call_f): New global variable.
diff --git a/arith.c b/arith.c
index 365818e3..a037e5df 100644
--- a/arith.c
+++ b/arith.c
@@ -2187,6 +2187,46 @@ val toint(val obj, val base)
   }
 }
 
+val width(val obj)
+{
+  switch (tag(obj)) {
+  case TAG_NUM:
+  case TAG_CHR:
+    {
+      cnum n = c_num(obj);
+
+      if (n < 0) {
+        n &= INT_PTR_MAX;
+        n ^= INT_PTR_MAX;
+        return num_fast(highest_bit(n));
+      }
+      return num_fast(highest_bit(n));
+    }
+  case TAG_PTR:
+    if (type(obj) == BGNUM) {
+      int count;
+      if (mp_cmp_z(mp(obj)) == MP_LT) {
+        mp_int tmp;
+        int i;
+
+        mp_2comp(mp(obj), &tmp, mp(obj)->used);
+
+        for (i = 0; i < tmp.used; i++)
+          tmp.dp[i] ^= MP_DIGIT_MAX;
+
+        count = mp_count_bits(&tmp);
+        mp_clear(&tmp);
+      } else {
+        count = mp_count_bits(mp(obj));
+      }
+      return num(count);
+    }
+  default:
+    break;
+  }
+  uw_throwf(error_s, lit("integer-length: ~s isn't an integer"), obj, nao);
+}
+
 void arith_init(void)
 {
   mp_init(&NUM_MAX_MP);
diff --git a/arith.h b/arith.h
index 2633c296..29561c61 100644
--- a/arith.h
+++ b/arith.h
@@ -35,4 +35,5 @@ val n_choose_k(val n, val k);
 val n_perm_k(val n, val k);
 val tofloat(val obj);
 val toint(val obj, val base);
+val width(val num);
 void arith_init(void);
diff --git a/eval.c b/eval.c
index 48925f79..8a795f12 100644
--- a/eval.c
+++ b/eval.c
@@ -3851,6 +3851,7 @@ void eval_init(void)
   reg_fun(intern(lit("ash"), user_package), func_n2(ash));
   reg_fun(intern(lit("bit"), user_package), func_n2(bit));
   reg_fun(intern(lit("mask"), user_package), func_n0v(maskv));
+  reg_fun(intern(lit("width"), user_package), func_n1(width));
 
   reg_fun(intern(lit("regex-compile"), user_package), func_n2o(regex_compile, 1));
   reg_fun(intern(lit("regexp"), user_package), func_n1(regexp));
diff --git a/txr.1 b/txr.1
index 668a12c9..5d064cc7 100644
--- a/txr.1
+++ b/txr.1
@@ -19395,6 +19395,34 @@ In other words, the following equivalences hold:
   (mask a b c ...) <--> (logior (mask a) (mask b) (mask c) ...)
 .cble
 
+.coNP Function @ width
+.synb
+.mets (width << integer *)
+.syne
+.desc
+A two's complement representation of an integer consists of a sign bit and a
+manitssa field.
+The
+.code width
+function computes the minimum number of bits required for the mantissa portion
+of the two's complement representation of the
+.meta integer
+argument.
+
+For a nonnegative argument, the width also corresponds to the number of bits
+required for a natural binary representation of that value.
+
+Two integer values have a width of zero, namely 0 and -1. This means that these
+two values can be represented in a one-bit two's complement, consisting of only
+a sign bit: the one-bit two's complement bitfield 1 denotes -1, and 0 denotes
+0.
+
+Similarly, two integer values have a width of 1: 1 and -2. The two-bit
+two's complement bitfield 01 denotes 1, and 10 denotes -2.
+
+The argument may be a character.
+
+
 .SS* Exceptions
 .coNP Functions @, throw @ throwf and @ error
 .synb