From e9b78ff2c7a7765b842588c9a93f84956de9834d Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 27 Jan 2015 06:30:11 -0800
Subject: * arith.c (width): New function.

* arith.h (width): Declared.

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

* txr.1: Documented width.
---
 arith.c | 40 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 40 insertions(+)

(limited to 'arith.c')

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);
-- 
cgit v1.2.3