5 files changed, 71 insertions, 0 deletions

diff --git a/ChangeLog b/ChangeLog
index 39e95ff2..49e0a6c1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,15 @@
 2011-12-13  Kaz Kylheku  <kaz@kylheku.com>
 
+	* arith.c (exptmod, gcd): New functions.
+
+	* eval.c (eval_init): New functions registered as intrisics.
+
+	* lib.h (exptmod, gcd): Declared.
+
+	* txr.1: Documentation stubs added.
+
+2011-12-13  Kaz Kylheku  <kaz@kylheku.com>
+
 	* arith.c (evenp, oddp): New functions.
 
 	* eval.c (eval_init): New functions registered as intrinsics.
diff --git a/arith.c b/arith.c
index bde39aad..f222617d 100644
--- a/arith.c
+++ b/arith.c
@@ -932,6 +932,34 @@ val expt(val anum, val bnum)
   abort();
 }
 
+val exptmod(val base, val exp, val mod)
+{
+  val n;
+
+  if (!numberp(base) || !numberp(exp) || !numberp(mod))
+    goto inval;
+
+  if (fixnump(base))
+    base = bignum(c_num(base));
+
+  if (fixnump(exp))
+    exp = bignum(c_num(exp));
+
+  if (fixnump(mod))
+    mod = bignum(c_num(mod));
+
+  n = make_bignum();
+
+  if (mp_exptmod(mp(base), mp(exp), mp(mod), mp(n)) != MP_OKAY)
+    goto inval;
+
+  return n;
+inval:
+  uw_throwf(error_s, lit("exptmod: invalid operands ~s ~s ~s"),
+            base, exp, mod, nao);
+  abort();
+}
+
 static int_ptr_t isqrt_fixnum(int_ptr_t a)
 {
   int_ptr_t mask = (int_ptr_t) 1 << (highest_bit(a) / 2);
@@ -962,6 +990,31 @@ val isqrt(val anum)
   uw_throwf(error_s, lit("sqrt: invalid operand ~s"), anum, nao);
 }
 
+val gcd(val anum, val bnum)
+{
+  val n;
+
+  if (!numberp(anum) || !numberp(bnum))
+    goto inval;
+
+  if (fixnump(anum))
+    anum = bignum(c_num(anum));
+
+  if (fixnump(bnum))
+    bnum = bignum(c_num(bnum));
+
+  n = make_bignum();
+
+  if (mp_gcd(mp(anum), mp(bnum), mp(n)) != MP_OKAY)
+    goto inval;
+
+  return n;
+inval:
+  uw_throwf(error_s, lit("gcd: invalid operands ~s ~s ~s"),
+            anum, bnum, nao);
+  abort();
+}
+
 void arith_init(void)
 {
   mp_init(&NUM_MAX_MP);
diff --git a/eval.c b/eval.c
index c886e89f..eedd2d56 100644
--- a/eval.c
+++ b/eval.c
@@ -1160,7 +1160,9 @@ void eval_init(void)
   reg_fun(intern(lit("trunc"), user_package), func_n2(trunc));
   reg_fun(intern(lit("mod"), user_package), func_n2(mod));
   reg_fun(intern(lit("expt"), user_package), func_n0v(exptv));
+  reg_fun(intern(lit("exptmod"), user_package), func_n3(exptmod));
   reg_fun(intern(lit("sqrt"), user_package), func_n1(isqrt));
+  reg_fun(intern(lit("gcd"), user_package), func_n2(gcd));
   reg_fun(intern(lit("fixnump"), user_package), func_n1(fixnump));
   reg_fun(intern(lit("bignump"), user_package), func_n1(bignump));
   reg_fun(intern(lit("numberp"), user_package), func_n1(numberp));
diff --git a/lib.h b/lib.h
index e206184e..a3d6019d 100644
--- a/lib.h
+++ b/lib.h
@@ -391,7 +391,9 @@ val maxv(val first, val rest);
 val minv(val first, val rest);
 val expt(val base, val exp);
 val exptv(val nlist);
+val exptmod(val base, val exp, val mod);
 val isqrt(val anum);
+val gcd(val anum, val bnum);
 val string_own(wchar_t *str);
 val string(const wchar_t *str);
 val string_utf8(const char *str);
diff --git a/txr.1 b/txr.1
index d2f58d4e..4cebd27b 100644
--- a/txr.1
+++ b/txr.1
@@ -4811,6 +4811,10 @@ The following are Lisp functions and variables built-in to TXR.
 
 .SS Arithmetic functions +, -, *, trunc, mod, expt, sqrt
 
+.SS Arithmetic function exptmod
+
+.SS Arithmetic function gcd
+
 .SS Arithmetic function abs
 
 .SS Functions fixnump, bignump, numberp