From cbd62a0ef30d63eb83748c51a0ea1bac491c3a8c Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 13 Dec 2021 09:50:14 +0100 Subject: [PATCH] Implement truncate-remainder with new integer lib * libguile/integers.c (scm_integer_truncate_remainder_ii) (scm_integer_truncate_remainder_iz, scm_integer_truncate_remainder_zi) (scm_integer_truncate_remainder_zz): New internal functions. * libguile/integers.h: Declare internal functions. * libguile/numbers.c (scm_truncate_remainder): Use the new functions. --- libguile/integers.c | 53 +++++++++++++++++++++++++++++++++++++++++++ libguile/integers.h | 5 +++++ libguile/numbers.c | 55 +++++++++------------------------------------ 3 files changed, 68 insertions(+), 45 deletions(-) diff --git a/libguile/integers.c b/libguile/integers.c index 5653fa8d2..0d2bfb238 100644 --- a/libguile/integers.c +++ b/libguile/integers.c @@ -874,3 +874,56 @@ scm_integer_truncate_quotient_zz (SCM x, SCM y) scm_remember_upto_here_2 (x, y); return take_mpz (q); } + +SCM +scm_integer_truncate_remainder_ii (scm_t_inum x, scm_t_inum y) +{ + if (y == 0) + scm_num_overflow ("truncate-remainder"); + else + { + scm_t_inum q = x % y; + return long_to_scm (q); + } +} + +SCM +scm_integer_truncate_remainder_iz (scm_t_inum x, SCM y) +{ + 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); + return SCM_INUM0; + } + else + return SCM_I_MAKINUM (x); +} + +SCM +scm_integer_truncate_remainder_zi (SCM x, scm_t_inum y) +{ + if (y == 0) + scm_num_overflow ("truncate-remainder"); + else + { + mpz_t zx; + alias_bignum_to_mpz (scm_bignum (x), zx); + scm_t_inum r = mpz_tdiv_ui (zx, (y > 0) ? y : -y) * mpz_sgn (zx); + scm_remember_upto_here_1 (x); + return SCM_I_MAKINUM (r); + } +} + +SCM +scm_integer_truncate_remainder_zz (SCM x, SCM y) +{ + mpz_t r, zx, zy; + mpz_init (r); + alias_bignum_to_mpz (scm_bignum (x), zx); + alias_bignum_to_mpz (scm_bignum (y), zy); + mpz_tdiv_r (r, zx, zy); + scm_remember_upto_here_2 (x, y); + return take_mpz (r); +} diff --git a/libguile/integers.h b/libguile/integers.h index 9707444f7..9b6d8b5d2 100644 --- a/libguile/integers.h +++ b/libguile/integers.h @@ -72,6 +72,11 @@ SCM_INTERNAL SCM scm_integer_truncate_quotient_iz (scm_t_inum x, SCM y); SCM_INTERNAL SCM scm_integer_truncate_quotient_zi (SCM x, scm_t_inum y); SCM_INTERNAL SCM scm_integer_truncate_quotient_zz (SCM x, SCM y); +SCM_INTERNAL SCM scm_integer_truncate_remainder_ii (scm_t_inum x, scm_t_inum y); +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); + #endif /* SCM_INTEGERS_H */ diff --git a/libguile/numbers.c b/libguile/numbers.c index 7abc727d7..e59784543 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -1908,32 +1908,16 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_remainder, "truncate-remainder", 2, 0, 0, "@end lisp") #define FUNC_NAME s_scm_truncate_remainder { - 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_remainder); - else - return SCM_I_MAKINUM (xx % yy); - } + if (SCM_I_INUMP (y)) + return scm_integer_truncate_remainder_ii (SCM_I_INUM (x), + SCM_I_INUM (y)); 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); - return SCM_INUM0; - } - else - return x; - } + return scm_integer_truncate_remainder_iz (SCM_I_INUM (x), y); else if (SCM_REALP (y)) - return scm_i_inexact_truncate_remainder (xx, SCM_REAL_VALUE (y)); + return scm_i_inexact_truncate_remainder (SCM_I_INUM (x), + SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_truncate_remainder (x, y); else @@ -1942,29 +1926,10 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_remainder, "truncate-remainder", 2, 0, 0, } 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_remainder); - else - { - scm_t_inum rr = (mpz_tdiv_ui (SCM_I_BIG_MPZ (x), - (yy > 0) ? yy : -yy) - * mpz_sgn (SCM_I_BIG_MPZ (x))); - scm_remember_upto_here_1 (x); - return SCM_I_MAKINUM (rr); - } - } + if (SCM_I_INUMP (y)) + return scm_integer_truncate_remainder_zi (x, SCM_I_INUM (y)); else if (SCM_BIGP (y)) - { - SCM r = scm_i_mkbig (); - mpz_tdiv_r (SCM_I_BIG_MPZ (r), - SCM_I_BIG_MPZ (x), - SCM_I_BIG_MPZ (y)); - scm_remember_upto_here_2 (x, y); - return scm_i_normbig (r); - } + return scm_integer_truncate_remainder_zz (x, y); else if (SCM_REALP (y)) return scm_i_inexact_truncate_remainder (scm_i_big2dbl (x), SCM_REAL_VALUE (y));