* arith.c (make_ubignum): New static function.

(sign_extend): New function.

* eval.c (eval_init): Register sign-extend intrinsic.

* lib.h (sign_extend): Declared.

* txr.1: Documented sign-extend.

* tl.vim, txr.vim: Updated.

1 files changed, 34 insertions, 0 deletions

diff --git a/arith.c b/arith.c
index a037e5df..8e4976db 100644
--- a/arith.c
+++ b/arith.c
@@ -58,6 +58,13 @@ val make_bignum(void)
   return n;
 }
 
+static val make_ubignum(void)
+{
+  val n = make_obj();
+  n->bn.type = BGNUM;
+  return n;
+}
+
 val bignum(cnum cn)
 {
   val n = make_bignum();
@@ -1893,6 +1900,33 @@ bad3:
   uw_throwf(error_s, lit("logtrunc: non-integral operand ~s"), a, nao);
 }
 
+val sign_extend(val n, val nbits)
+{
+  val msb = minus(nbits, one);
+  val ntrunc = logtrunc(n, nbits);
+
+  if (bit(ntrunc, msb)) {
+    switch (type(ntrunc)) {
+    case NUM:
+      {
+        cnum cn = c_num(ntrunc);
+        cnum nb = c_num(nbits);
+        return num(cn | (INT_PTR_MAX << nb));
+      }
+    case BGNUM:
+      {
+        val out = make_ubignum();
+        mp_2comp(mp(ntrunc), mp(out), mp(ntrunc)->used);
+        mp_neg(mp(out), mp(out));
+        return normalize(out);
+      }
+    default:
+      internal_error("impossible case");
+    }
+  }
+  return ntrunc;
+}
+
 val ash(val a, val bits)
 {
   cnum an, bn;