* arith.c (highest_bit): Linkage changed to static.

(abso, isqrt): New functions.
(isqrt_fixnum): New static function.

* eval.c (eval_init): Registered abs, sqrt and numberp instrinsics.

* lib.c (numberp): New function.

* lib.h (numberp, abso, isqrt): Declared.

* mpi-patches/series: New patch added.

* mpi-patches/faster-square-root: New patch added.

* txr.1: Documentation stubs for new functions.

1 files changed, 43 insertions, 1 deletions

diff --git a/arith.c b/arith.c
index 27034a2a..1ccab1f6 100644
--- a/arith.c
+++ b/arith.c
@@ -84,7 +84,7 @@ static val normalize(val bignum)
   }
 }
 
-int highest_bit(int_ptr_t n)
+static int highest_bit(int_ptr_t n)
 {
 #if SIZEOF_PTR == 8
   if (n & 0x7FFFFFFF00000000) {
@@ -414,6 +414,18 @@ val neg(val anum)
   }
 }
 
+val abso(val anum)
+{
+  if (bignump(anum)) {
+    val n = make_bignum();
+    mp_abs(mp(anum), mp(n));
+    return n;
+  } else {
+    cnum n = c_num(anum);
+    return num(n < 0 ? n : n);
+  }
+}
+
 val mul(val anum, val bnum)
 {
   int tag_a = tag(anum);
@@ -890,6 +902,36 @@ val expt(val anum, val bnum)
   abort();
 }
 
+static int_ptr_t isqrt_fixnum(int_ptr_t a)
+{
+  int_ptr_t mask = (int_ptr_t) 1 << (highest_bit(a) / 2);
+  int_ptr_t root = 0;
+
+  for (; mask != 0; mask >>= 1) {
+    int_ptr_t next_guess = root | mask;
+    if (next_guess * next_guess <= a)
+      root = next_guess;
+  }
+
+  return root;
+}
+
+val isqrt(val anum)
+{
+  if (fixnump(anum)) {
+    cnum a = c_num(anum);
+    if (a < 0)
+      uw_throw(error_s, lit("sqrt: negative operand"));
+    return num_fast(isqrt_fixnum(c_num(anum)));
+  } else if (bignump(anum)) {
+    val n = make_bignum();
+    if (mp_sqrt(mp(anum), mp(n)) != MP_OKAY)
+      uw_throw(error_s, lit("sqrt: negative operand"));
+    return normalize(n);
+  }
+  uw_throwf(error_s, lit("sqrt: invalid operand ~s"), anum, nao);
+}
+
 void arith_init(void)
 {
   mp_init(&NUM_MAX_MP);