[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 09/85: Implement ceiling-divide with new integer lib
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 09/85: Implement ceiling-divide with new integer lib |
|
Date: |
Thu, 13 Jan 2022 03:40:13 -0500 (EST) |
wingo pushed a commit to branch main
in repository guile.
commit 1e1b2302239c33a5e6279cb178ccc9b278371905
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Mon Dec 13 09:19:53 2021 +0100
Implement ceiling-divide with new integer lib
* libguile/integers.c (scm_integer_ceiling_divide_ii)
(scm_integer_ceiling_divide_iz, scm_integer_ceiling_divide_zi)
(scm_integer_ceiling_divide_zz): New internal functions.
* libguile/integers.h: Declare internal functions.
* libguile/numbers.c (scm_ceiling_divide): Use the new functions.
---
libguile/integers.c | 146 ++++++++++++++++++++++++++++++++++++++++++++++------
libguile/integers.h | 9 ++++
libguile/numbers.c | 115 +++--------------------------------------
3 files changed, 146 insertions(+), 124 deletions(-)
diff --git a/libguile/integers.c b/libguile/integers.c
index eee09797e..1d2254745 100644
--- a/libguile/integers.c
+++ b/libguile/integers.c
@@ -250,7 +250,7 @@ normalize_bignum (struct scm_bignum *z)
}
static SCM
-take_bignum_from_mpz (mpz_ptr mpz)
+take_mpz (mpz_ptr mpz)
{
struct scm_bignum *res = make_bignum_from_mpz (mpz);
mpz_clear (mpz);
@@ -358,7 +358,7 @@ scm_integer_floor_quotient_zi (SCM x, scm_t_inum y)
mpz_neg (q, q);
}
scm_remember_upto_here_1 (x);
- return take_bignum_from_mpz (q);
+ return take_mpz (q);
}
SCM
@@ -370,7 +370,7 @@ scm_integer_floor_quotient_zz (SCM x, SCM y)
mpz_init (q);
mpz_fdiv_q (q, zx, zy);
scm_remember_upto_here_2 (x, y);
- return take_bignum_from_mpz (q);
+ return take_mpz (q);
}
SCM
@@ -397,7 +397,7 @@ scm_integer_floor_remainder_iz (scm_t_inum x, SCM y)
alias_bignum_to_mpz (scm_bignum (y), zy);
mpz_sub_ui (r, zy, -x);
scm_remember_upto_here_1 (y);
- return take_bignum_from_mpz (r);
+ return take_mpz (r);
}
else
return SCM_I_MAKINUM (x);
@@ -411,7 +411,7 @@ scm_integer_floor_remainder_iz (scm_t_inum x, SCM y)
alias_bignum_to_mpz (scm_bignum (y), zy);
mpz_add_ui (r, zy, x);
scm_remember_upto_here_1 (y);
- return take_bignum_from_mpz (r);
+ return take_mpz (r);
}
}
@@ -443,7 +443,7 @@ scm_integer_floor_remainder_zz (SCM x, SCM y)
mpz_init (r);
mpz_fdiv_r (r, zx, zy);
scm_remember_upto_here_2 (x, y);
- return take_bignum_from_mpz (r);
+ return take_mpz (r);
}
void
@@ -479,7 +479,7 @@ scm_integer_floor_divide_iz (scm_t_inum x, SCM y, SCM *qp,
SCM *rp)
mpz_sub_ui (r, zy, -x);
scm_remember_upto_here_1 (y);
*qp = SCM_I_MAKINUM (-1);
- *rp = take_bignum_from_mpz (r);
+ *rp = take_mpz (r);
}
else
{
@@ -500,7 +500,7 @@ scm_integer_floor_divide_iz (scm_t_inum x, SCM y, SCM *qp,
SCM *rp)
mpz_add_ui (r, zy, x);
scm_remember_upto_here_1 (y);
*qp = SCM_I_MAKINUM (-1);
- *rp = take_bignum_from_mpz (r);
+ *rp = take_mpz (r);
}
}
@@ -522,8 +522,8 @@ scm_integer_floor_divide_zi (SCM x, scm_t_inum y, SCM *qp,
SCM *rp)
mpz_neg (q, q);
}
scm_remember_upto_here_1 (x);
- *qp = take_bignum_from_mpz (q);
- *rp = take_bignum_from_mpz (r);
+ *qp = take_mpz (q);
+ *rp = take_mpz (r);
}
void
@@ -536,8 +536,8 @@ scm_integer_floor_divide_zz (SCM x, SCM y, SCM *qp, SCM *rp)
alias_bignum_to_mpz (scm_bignum (y), zy);
mpz_fdiv_qr (q, r, zx, zy);
scm_remember_upto_here_2 (x, y);
- *qp = take_bignum_from_mpz (q);
- *rp = take_bignum_from_mpz (r);
+ *qp = take_mpz (q);
+ *rp = take_mpz (r);
}
SCM
@@ -601,7 +601,7 @@ scm_integer_ceiling_quotient_zi (SCM x, scm_t_inum y)
mpz_neg (q, q);
}
scm_remember_upto_here_1 (x);
- return take_bignum_from_mpz (q);
+ return take_mpz (q);
}
}
@@ -614,7 +614,7 @@ scm_integer_ceiling_quotient_zz (SCM x, SCM y)
alias_bignum_to_mpz (scm_bignum (y), zy);
mpz_cdiv_q (q, zx, zy);
scm_remember_upto_here_2 (x, y);
- return take_bignum_from_mpz (q);
+ return take_mpz (q);
}
SCM
@@ -644,7 +644,7 @@ scm_integer_ceiling_remainder_iz (scm_t_inum x, SCM y)
mpz_sub_ui (r, zy, x);
scm_remember_upto_here_1 (y);
mpz_neg (r, r);
- return take_bignum_from_mpz (r);
+ return take_mpz (r);
}
else if (x == SCM_MOST_NEGATIVE_FIXNUM &&
bignum_cmp_long (scm_bignum (y), -SCM_MOST_NEGATIVE_FIXNUM) ==
0)
@@ -666,7 +666,7 @@ scm_integer_ceiling_remainder_iz (scm_t_inum x, SCM y)
mpz_add_ui (r, zy, -x);
scm_remember_upto_here_1 (y);
mpz_neg (r, r);
- return take_bignum_from_mpz (r);
+ return take_mpz (r);
}
}
@@ -698,5 +698,117 @@ scm_integer_ceiling_remainder_zz (SCM x, SCM y)
alias_bignum_to_mpz (scm_bignum (y), zy);
mpz_cdiv_r (r, zx, zy);
scm_remember_upto_here_2 (x, y);
- return take_bignum_from_mpz (r);
+ return take_mpz (r);
+}
+
+void
+scm_integer_ceiling_divide_ii (scm_t_inum x, scm_t_inum y, SCM *qp, SCM *rp)
+{
+ if (y == 0)
+ scm_num_overflow ("ceiling-divide");
+ else
+ {
+ scm_t_inum q = x / y;
+ scm_t_inum r = x % y;
+ int needs_adjustment;
+
+ if (y > 0)
+ needs_adjustment = (r > 0);
+ else
+ needs_adjustment = (r < 0);
+
+ if (needs_adjustment)
+ {
+ r -= y;
+ q++;
+ }
+ *qp = long_to_scm (q);
+ *rp = SCM_I_MAKINUM (r);
+ }
+}
+
+void
+scm_integer_ceiling_divide_iz (scm_t_inum x, SCM y, SCM *qp, SCM *rp)
+{
+ if (bignum_is_positive (scm_bignum (y)))
+ {
+ if (x > 0)
+ {
+ mpz_t r, zy;
+ mpz_init (r);
+ alias_bignum_to_mpz (scm_bignum (y), zy);
+ mpz_sub_ui (r, zy, x);
+ scm_remember_upto_here_1 (y);
+ mpz_neg (r, r);
+ *qp = SCM_INUM1;
+ *rp = take_mpz (r);
+ }
+ else 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);
+ }
+ }
+ else if (x >= 0)
+ {
+ *qp = SCM_INUM0;
+ *rp = SCM_I_MAKINUM (x);
+ }
+ else
+ {
+ mpz_t r, zy;
+ mpz_init (r);
+ alias_bignum_to_mpz (scm_bignum (y), zy);
+ mpz_add_ui (r, zy, -x);
+ scm_remember_upto_here_1 (y);
+ mpz_neg (r, r);
+ *qp = SCM_INUM1;
+ *rp = take_mpz (r);
+ }
+}
+
+void
+scm_integer_ceiling_divide_zi (SCM x, scm_t_inum y, SCM *qp, SCM *rp)
+{
+ if (y == 0)
+ scm_num_overflow ("ceiling-divide");
+ else
+ {
+ mpz_t q, r, zx;
+ mpz_init (q);
+ mpz_init (r);
+ alias_bignum_to_mpz (scm_bignum (x), zx);
+ if (y > 0)
+ mpz_cdiv_qr_ui (q, r, zx, y);
+ else
+ {
+ mpz_fdiv_qr_ui (q, r, zx, -y);
+ mpz_neg (q, q);
+ }
+ scm_remember_upto_here_1 (x);
+ *qp = take_mpz (q);
+ *rp = take_mpz (r);
+ }
+}
+
+void
+scm_integer_ceiling_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_cdiv_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 acacc7ac1..331f4aec6 100644
--- a/libguile/integers.h
+++ b/libguile/integers.h
@@ -58,6 +58,15 @@ SCM_INTERNAL SCM scm_integer_ceiling_remainder_iz
(scm_t_inum x, SCM y);
SCM_INTERNAL SCM scm_integer_ceiling_remainder_zi (SCM x, scm_t_inum y);
SCM_INTERNAL SCM scm_integer_ceiling_remainder_zz (SCM x, SCM y);
+SCM_INTERNAL void scm_integer_ceiling_divide_ii (scm_t_inum x, scm_t_inum y,
+ SCM *qp, SCM *rp);
+SCM_INTERNAL void scm_integer_ceiling_divide_iz (scm_t_inum x, SCM y,
+ SCM *qp, SCM *rp);
+SCM_INTERNAL void scm_integer_ceiling_divide_zi (SCM x, scm_t_inum y,
+ SCM *qp, SCM *rp);
+SCM_INTERNAL void scm_integer_ceiling_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 dd532c2fc..2e73bac1d 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -1717,84 +1717,14 @@ SCM_PRIMITIVE_GENERIC (scm_i_ceiling_divide,
"ceiling/", 2, 0, 0,
void
scm_ceiling_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_ceiling_divide);
- else
- {
- scm_t_inum qq = xx / yy;
- scm_t_inum rr = xx % yy;
- int needs_adjustment;
-
- if (SCM_LIKELY (yy > 0))
- needs_adjustment = (rr > 0);
- else
- needs_adjustment = (rr < 0);
-
- if (needs_adjustment)
- {
- rr -= yy;
- qq++;
- }
- 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_ceiling_divide_ii (SCM_I_INUM (x), SCM_I_INUM (y), qp, rp);
else if (SCM_BIGP (y))
- {
- int sign = mpz_sgn (SCM_I_BIG_MPZ (y));
- scm_remember_upto_here_1 (y);
- if (SCM_LIKELY (sign > 0))
- {
- if (SCM_LIKELY (xx > 0))
- {
- SCM r = scm_i_mkbig ();
- mpz_sub_ui (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (y), xx);
- scm_remember_upto_here_1 (y);
- mpz_neg (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (r));
- *qp = SCM_INUM1;
- *rp = scm_i_normbig (r);
- }
- else 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;
- }
- }
- else if (xx >= 0)
- {
- *qp = SCM_INUM0;
- *rp = x;
- }
- else
- {
- SCM r = scm_i_mkbig ();
- mpz_add_ui (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (y), -xx);
- scm_remember_upto_here_1 (y);
- mpz_neg (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (r));
- *qp = SCM_INUM1;
- *rp = scm_i_normbig (r);
- }
- }
+ scm_integer_ceiling_divide_iz (SCM_I_INUM (x), y, qp, rp);
else if (SCM_REALP (y))
- scm_i_inexact_ceiling_divide (xx, SCM_REAL_VALUE (y), qp, rp);
+ scm_i_inexact_ceiling_divide (SCM_I_INUM (x), SCM_REAL_VALUE (y), qp,
rp);
else if (SCM_FRACTIONP (y))
scm_i_exact_rational_ceiling_divide (x, y, qp, rp);
else
@@ -1803,39 +1733,10 @@ scm_ceiling_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_ceiling_divide);
- else
- {
- SCM q = scm_i_mkbig ();
- SCM r = scm_i_mkbig ();
- if (yy > 0)
- mpz_cdiv_qr_ui (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (r),
- SCM_I_BIG_MPZ (x), yy);
- else
- {
- mpz_fdiv_qr_ui (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (r),
- SCM_I_BIG_MPZ (x), -yy);
- mpz_neg (SCM_I_BIG_MPZ (q), SCM_I_BIG_MPZ (q));
- }
- scm_remember_upto_here_1 (x);
- *qp = scm_i_normbig (q);
- *rp = scm_i_normbig (r);
- }
- }
+ if (SCM_I_INUMP (y))
+ scm_integer_ceiling_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_cdiv_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_ceiling_divide_zz (x, y, qp, rp);
else if (SCM_REALP (y))
scm_i_inexact_ceiling_divide (scm_i_big2dbl (x), SCM_REAL_VALUE (y),
qp, rp);
- [Guile-commits] 58/85: Remove dead bignum frexp code from numbers.c, (continued)
- [Guile-commits] 58/85: Remove dead bignum frexp code from numbers.c, Andy Wingo, 2022/01/13
- [Guile-commits] 53/85: Remove unused conv-{u,}integer.i.c, Andy Wingo, 2022/01/13
- [Guile-commits] 63/85: Use scm_integer_to_double_z in numbers.c instead of big2dbl, Andy Wingo, 2022/01/13
- [Guile-commits] 66/85: Finish srfi-60 port off old scm mpz API, Andy Wingo, 2022/01/13
- [Guile-commits] 74/85: Less pessimal scm_integer_sub_zi, Andy Wingo, 2022/01/13
- [Guile-commits] 76/85: Avoid bignum clone in scm_integer_sub_zz, Andy Wingo, 2022/01/13
- [Guile-commits] 79/85: Optimize scm_integer_mul_ii, Andy Wingo, 2022/01/13
- [Guile-commits] 80/85: Optimize integer-expt for fixnums, Andy Wingo, 2022/01/13
- [Guile-commits] 81/85: Optimize logand against a positive inum, Andy Wingo, 2022/01/13
- [Guile-commits] 82/85: Simplify scm_abs for the real case, Andy Wingo, 2022/01/13
- [Guile-commits] 09/85: Implement ceiling-divide with new integer lib,
Andy Wingo <=
- [Guile-commits] 08/85: Implement ceiling-remainder with new integer lib, Andy Wingo, 2022/01/13
- [Guile-commits] 11/85: Implement truncate-remainder with new integer lib, Andy Wingo, 2022/01/13
- [Guile-commits] 49/85: Reimplement scm_from_int8 etc, Andy Wingo, 2022/01/13
- [Guile-commits] 55/85: Reimplement exact-integer-sqrt with integers.[ch], Andy Wingo, 2022/01/13
- [Guile-commits] 56/85: Refactor scm_sqrt in terms of integers.[ch], Andy Wingo, 2022/01/13
- [Guile-commits] 62/85: Simplify magnitude, angle, Andy Wingo, 2022/01/13
- [Guile-commits] 65/85: Start porting srfi-60 off the bad bignum interfaces, Andy Wingo, 2022/01/13
- [Guile-commits] 72/85: Optimize scm_integer_mul_zi, Andy Wingo, 2022/01/13
- [Guile-commits] 75/85: Start to optimize scm_integer_sub_iz, Andy Wingo, 2022/01/13
- [Guile-commits] 77/85: Optimize bignum add to avoid temporary allocations, Andy Wingo, 2022/01/13