Implement truncate-divide with new integer lib

* libguile/integers.c (scm_integer_truncate_divide_ii)
(scm_integer_truncate_divide_iz, scm_integer_truncate_divide_zi)
(scm_integer_truncate_divide_zz): New internal functions.
* libguile/integers.h: Declare internal functions.
* libguile/numbers.c (scm_truncate_divide): Use the new functions.

3 files changed, 90 insertions, 68 deletions

diff --git a/libguile/integers.c b/libguile/integers.c
index 0d2bfb238..402b2e3c9 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -927,3 +927,74 @@ scm_integer_truncate_remainder_zz (SCM x, SCM y)
   scm_remember_upto_here_2 (x, y);
   return take_mpz (r);
 }
+
+void
+scm_integer_truncate_divide_ii (scm_t_inum x, scm_t_inum y, SCM *qp, SCM *rp)
+{
+  if (y == 0)
+    scm_num_overflow ("truncate-divide");
+  else
+    {
+      scm_t_inum q = x / y;
+      scm_t_inum r = x % y;
+      *qp = long_to_scm (q);
+      *rp = SCM_I_MAKINUM (r);
+    }
+}
+
+void
+scm_integer_truncate_divide_iz (scm_t_inum x, SCM y, SCM *qp, SCM *rp)
+{
+  if (x == SCM_MOST_NEGATIVE_FIXNUM &&
+      bignum_cmp_long (scm_bignum (y), -SCM_MOST_NEGATIVE_FIXNUM) == 0)
+    {
+      /* Special case: x == fixnum-min && y == abs (fixnum-min) */
+      scm_remember_upto_here_1 (y);
+      *qp = SCM_I_MAKINUM (-1);
+      *rp = SCM_INUM0;
+    }
+  else
+    {
+      *qp = SCM_INUM0;
+      *rp = SCM_I_MAKINUM (x);
+    }
+}
+
+void
+scm_integer_truncate_divide_zi (SCM x, scm_t_inum y, SCM *qp, SCM *rp)
+{
+  if (y == 0)
+    scm_num_overflow ("truncate-divide");
+  else
+    {
+      mpz_t q, zx;
+      mpz_init (q);
+      alias_bignum_to_mpz (scm_bignum (x), zx);
+      scm_t_inum r;
+      if (y > 0)
+        r = mpz_tdiv_q_ui (q, zx, y);
+      else
+        {
+          r = mpz_tdiv_q_ui (q, zx, -y);
+          mpz_neg (q, q);
+        }
+      r *= mpz_sgn (zx);
+      scm_remember_upto_here_1 (x);
+      *qp = take_mpz (q);
+      *rp = SCM_I_MAKINUM (r);
+    }
+}
+
+void
+scm_integer_truncate_divide_zz (SCM x, SCM y, SCM *qp, SCM *rp)
+{
+  mpz_t q, r, zx, zy;
+  mpz_init (q);
+  mpz_init (r);
+  alias_bignum_to_mpz (scm_bignum (x), zx);
+  alias_bignum_to_mpz (scm_bignum (y), zy);
+  mpz_tdiv_qr (q, r, zx, zy);
+  scm_remember_upto_here_2 (x, y);
+  *qp = take_mpz (q);
+  *rp = take_mpz (r);
+}
diff --git a/libguile/integers.h b/libguile/integers.h
index 9b6d8b5d2..bd25a4b48 100644
--- a/libguile/integers.h
+++ b/libguile/integers.h
@@ -77,6 +77,15 @@ SCM_INTERNAL SCM scm_integer_truncate_remainder_iz (scm_t_inum x, SCM y);
 SCM_INTERNAL SCM scm_integer_truncate_remainder_zi (SCM x, scm_t_inum y);
 SCM_INTERNAL SCM scm_integer_truncate_remainder_zz (SCM x, SCM y);
 
+SCM_INTERNAL void scm_integer_truncate_divide_ii (scm_t_inum x, scm_t_inum y,
+                                                  SCM *qp, SCM *rp);
+SCM_INTERNAL void scm_integer_truncate_divide_iz (scm_t_inum x, SCM y,
+                                                  SCM *qp, SCM *rp);
+SCM_INTERNAL void scm_integer_truncate_divide_zi (SCM x, scm_t_inum y,
+                                                  SCM *qp, SCM *rp);
+SCM_INTERNAL void scm_integer_truncate_divide_zz (SCM x, SCM y,
+                                                  SCM *qp, SCM *rp);
+
 
 
 #endif  /* SCM_INTEGERS_H */
diff --git a/libguile/numbers.c b/libguile/numbers.c
index e59784543..00491e171 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -2026,44 +2026,16 @@ SCM_PRIMITIVE_GENERIC (scm_i_truncate_divide, "truncate/", 2, 0, 0,
 void
 scm_truncate_divide (SCM x, SCM y, SCM *qp, SCM *rp)
 {
-  if (SCM_LIKELY (SCM_I_INUMP (x)))
+  if (SCM_I_INUMP (x))
     {
-      scm_t_inum xx = SCM_I_INUM (x);
-      if (SCM_LIKELY (SCM_I_INUMP (y)))
-	{
-	  scm_t_inum yy = SCM_I_INUM (y);
-	  if (SCM_UNLIKELY (yy == 0))
-	    scm_num_overflow (s_scm_truncate_divide);
-	  else
-	    {
-	      scm_t_inum qq = xx / yy;
-	      scm_t_inum rr = xx % yy;
-	      if (SCM_LIKELY (SCM_FIXABLE (qq)))
-		*qp = SCM_I_MAKINUM (qq);
-	      else
-		*qp = scm_i_inum2big (qq);
-	      *rp = SCM_I_MAKINUM (rr);
-	    }
-	}
+      if (SCM_I_INUMP (y))
+        scm_integer_truncate_divide_ii (SCM_I_INUM (x), SCM_I_INUM (y),
+                                        qp, rp);
       else if (SCM_BIGP (y))
-	{
-	  if (SCM_UNLIKELY (xx == SCM_MOST_NEGATIVE_FIXNUM)
-	      && SCM_UNLIKELY (mpz_cmp_ui (SCM_I_BIG_MPZ (y),
-					   - SCM_MOST_NEGATIVE_FIXNUM) == 0))
-	    {
-	      /* Special case: x == fixnum-min && y == abs (fixnum-min) */
-	      scm_remember_upto_here_1 (y);
-	      *qp = SCM_I_MAKINUM (-1);
-	      *rp = SCM_INUM0;
-	    }
-	  else
-	    {
-	      *qp = SCM_INUM0;
-	      *rp = x;
-	    }
-	}
+        scm_integer_truncate_divide_iz (SCM_I_INUM (x), y, qp, rp);
       else if (SCM_REALP (y))
-	scm_i_inexact_truncate_divide (xx, SCM_REAL_VALUE (y), qp, rp);
+	scm_i_inexact_truncate_divide (SCM_I_INUM (x), SCM_REAL_VALUE (y),
+                                       qp, rp);
       else if (SCM_FRACTIONP (y))
 	scm_i_exact_rational_truncate_divide (x, y, qp, rp);
       else
@@ -2072,40 +2044,10 @@ scm_truncate_divide (SCM x, SCM y, SCM *qp, SCM *rp)
     }
   else if (SCM_BIGP (x))
     {
-      if (SCM_LIKELY (SCM_I_INUMP (y)))
-	{
-	  scm_t_inum yy = SCM_I_INUM (y);
-	  if (SCM_UNLIKELY (yy == 0))
-	    scm_num_overflow (s_scm_truncate_divide);
-	  else
-	    {
-	      SCM q = scm_i_mkbig ();
-	      scm_t_inum rr;
-	      if (yy > 0)
-		rr = mpz_tdiv_q_ui (SCM_I_BIG_MPZ (q),
-				    SCM_I_BIG_MPZ (x), yy);
-	      else
-		{
-		  rr = mpz_tdiv_q_ui (SCM_I_BIG_MPZ (q),
-				      SCM_I_BIG_MPZ (x), -yy);
-		  mpz_neg (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (q));
-		}
-	      rr *= mpz_sgn (SCM_I_BIG_MPZ (x));
-	      scm_remember_upto_here_1 (x);
-	      *qp = scm_i_normbig (q);
-	      *rp = SCM_I_MAKINUM (rr);
-	    }
-	}
+      if (SCM_I_INUMP (y))
+        scm_integer_truncate_divide_zi (x, SCM_I_INUM (y), qp, rp);
       else if (SCM_BIGP (y))
-	{
-	  SCM q = scm_i_mkbig ();
-	  SCM r = scm_i_mkbig ();
-	  mpz_tdiv_qr (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (r),
-		       SCM_I_BIG_MPZ (x), SCM_I_BIG_MPZ (y));
-	  scm_remember_upto_here_2 (x, y);
-	  *qp = scm_i_normbig (q);
-	  *rp = scm_i_normbig (r);
-	}
+        scm_integer_truncate_divide_zz (x, y, qp, rp);
       else if (SCM_REALP (y))
 	scm_i_inexact_truncate_divide (scm_i_big2dbl (x), SCM_REAL_VALUE (y),
                                        qp, rp);