summaryrefslogtreecommitdiff
path: root/libguile/srfi-60.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2022-01-07 13:34:57 +0100
committerAndy Wingo <wingo@pobox.com>2022-01-13 09:37:17 +0100
commite78bcdc29a196b5fec5fa2c4c6ad8576651de72e (patch)
tree6be8fb6288430028d09478ac3fbd7ec8a96296bf /libguile/srfi-60.c
parent399d0c8745d0e3a5adda402fc34983d849c4f48d (diff)
downloadguile-e78bcdc29a196b5fec5fa2c4c6ad8576651de72e.tar.gz
Finish srfi-60 port off old scm mpz API
* libguile/srfi-60.c (scm_srfi60_rotate_bit_field) (scm_srfi60_reverse_bit_field, scm_srfi60_integer_to_list) (scm_srfi60_list_to_integer): Update.
Diffstat (limited to 'libguile/srfi-60.c')
-rw-r--r--libguile/srfi-60.c149
1 files changed, 72 insertions, 77 deletions
diff --git a/libguile/srfi-60.c b/libguile/srfi-60.c
index 9ee0fed53..93bc68875 100644
--- a/libguile/srfi-60.c
+++ b/libguile/srfi-60.c
@@ -127,6 +127,8 @@ SCM_DEFINE (scm_srfi60_rotate_bit_field, "rotate-bit-field", 4, 0, 0,
else
cc = scm_to_ulong (scm_modulo (count, scm_difference (end, start)));
+ mpz_t zn;
+
if (SCM_I_INUMP (n))
{
long nn = SCM_I_INUM (n);
@@ -169,50 +171,51 @@ SCM_DEFINE (scm_srfi60_rotate_bit_field, "rotate-bit-field", 4, 0, 0,
if (cc == 0)
return n;
- n = scm_i_long2big (nn);
- goto big;
+ mpz_init_set_si (zn, nn);
}
}
else if (SCM_BIGP (n))
{
- mpz_t tmp;
- SCM r;
-
/* if there's no movement, avoid creating a new bignum. */
if (cc == 0)
return n;
+ scm_integer_init_set_mpz_z (scm_bignum (n), zn);
+ }
+ else
+ SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
- big:
- r = scm_i_ulong2big (0);
- mpz_init (tmp);
+ mpz_t tmp, r;
- /* portion above end */
- mpz_fdiv_q_2exp (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (n), ee);
- mpz_mul_2exp (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (r), ee);
+ mpz_init (tmp);
+ mpz_init_set_si (r, 0);
- /* field high part, width-count bits from start go to start+count */
- mpz_fdiv_q_2exp (tmp, SCM_I_BIG_MPZ (n), ss);
- mpz_fdiv_r_2exp (tmp, tmp, ww - cc);
- mpz_mul_2exp (tmp, tmp, ss + cc);
- mpz_ior (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (r), tmp);
+ /* portion above end */
+ mpz_fdiv_q_2exp (r, zn, ee);
+ mpz_mul_2exp (r, r, ee);
- /* field low part, count bits from end-count go to start */
- mpz_fdiv_q_2exp (tmp, SCM_I_BIG_MPZ (n), ee - cc);
- mpz_fdiv_r_2exp (tmp, tmp, cc);
- mpz_mul_2exp (tmp, tmp, ss);
- mpz_ior (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (r), tmp);
+ /* field high part, width-count bits from start go to start+count */
+ mpz_fdiv_q_2exp (tmp, zn, ss);
+ mpz_fdiv_r_2exp (tmp, tmp, ww - cc);
+ mpz_mul_2exp (tmp, tmp, ss + cc);
+ mpz_ior (r, r, tmp);
- /* portion below start */
- mpz_fdiv_r_2exp (tmp, SCM_I_BIG_MPZ (n), ss);
- mpz_ior (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (r), tmp);
+ /* field low part, count bits from end-count go to start */
+ mpz_fdiv_q_2exp (tmp, zn, ee - cc);
+ mpz_fdiv_r_2exp (tmp, tmp, cc);
+ mpz_mul_2exp (tmp, tmp, ss);
+ mpz_ior (r, r, tmp);
- mpz_clear (tmp);
+ /* portion below start */
+ mpz_fdiv_r_2exp (tmp, zn, ss);
+ mpz_ior (r, r, tmp);
- /* bits moved around might leave us in range of an inum */
- return scm_i_normbig (r);
- }
- else
- SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
+ mpz_clear (zn);
+ mpz_clear (tmp);
+
+ /* bits moved around might leave us in range of an inum */
+ SCM ret = scm_from_mpz (r);
+ mpz_clear (r);
+ return ret;
}
#undef FUNC_NAME
@@ -230,7 +233,7 @@ SCM_DEFINE (scm_srfi60_reverse_bit_field, "reverse-bit-field", 3, 0, 0,
long ss = scm_to_long (start);
long ee = scm_to_long (end);
long swaps = (ee - ss) / 2; /* number of swaps */
- SCM b;
+ mpz_t b;
if (SCM_I_INUMP (n))
{
@@ -258,9 +261,7 @@ SCM_DEFINE (scm_srfi60_reverse_bit_field, "reverse-bit-field", 3, 0, 0,
/* avoid creating a new bignum if reversing only 0 or 1 bits */
if (ee - ss <= 1)
return n;
-
- b = scm_i_long2big (nn);
- goto big;
+ mpz_init_set_si (b, nn);
}
}
else if (SCM_BIGP (n))
@@ -268,37 +269,36 @@ SCM_DEFINE (scm_srfi60_reverse_bit_field, "reverse-bit-field", 3, 0, 0,
/* avoid creating a new bignum if reversing only 0 or 1 bits */
if (ee - ss <= 1)
return n;
+ scm_integer_init_set_mpz_z (scm_bignum (n), b);
+ }
+ else
+ SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
- b = scm_i_clonebig (n, 1);
- big:
-
- ee--;
- for ( ; swaps > 0; swaps--)
+ ee--;
+ for ( ; swaps > 0; swaps--)
+ {
+ int sbit = mpz_tstbit (b, ss);
+ int ebit = mpz_tstbit (b, ee);
+ if (sbit ^ ebit)
{
- int sbit = mpz_tstbit (SCM_I_BIG_MPZ (b), ss);
- int ebit = mpz_tstbit (SCM_I_BIG_MPZ (b), ee);
- if (sbit ^ ebit)
+ /* the two bits are different, flip them */
+ if (sbit)
{
- /* the two bits are different, flip them */
- if (sbit)
- {
- mpz_clrbit (SCM_I_BIG_MPZ (b), ss);
- mpz_setbit (SCM_I_BIG_MPZ (b), ee);
- }
- else
- {
- mpz_setbit (SCM_I_BIG_MPZ (b), ss);
- mpz_clrbit (SCM_I_BIG_MPZ (b), ee);
- }
+ mpz_clrbit (b, ss);
+ mpz_setbit (b, ee);
+ }
+ else
+ {
+ mpz_setbit (b, ss);
+ mpz_clrbit (b, ee);
}
- ss++;
- ee--;
}
- /* swapping zero bits into the high might make us fit a fixnum */
- return scm_i_normbig (b);
+ ss++;
+ ee--;
}
- else
- SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
+ SCM ret = scm_integer_from_mpz (b);
+ mpz_clear (b);
+ return ret;
}
#undef FUNC_NAME
@@ -319,7 +319,7 @@ SCM_DEFINE (scm_srfi60_integer_to_list, "integer->list", 1, 1, 0,
#define FUNC_NAME s_scm_srfi60_integer_to_list
{
SCM ret = SCM_EOL;
- unsigned long ll, i;
+ unsigned long ll;
if (SCM_UNBNDP (len))
len = scm_integer_length (n);
@@ -327,22 +327,15 @@ SCM_DEFINE (scm_srfi60_integer_to_list, "integer->list", 1, 1, 0,
if (SCM_I_INUMP (n))
{
- long nn = SCM_I_INUM (n);
- for (i = 0; i < ll; i++)
- {
- unsigned long shift =
- (i < ((unsigned long) SCM_LONG_BIT-1))
- ? i : ((unsigned long) SCM_LONG_BIT-1);
- int bit = (nn >> shift) & 1;
- ret = scm_cons (scm_from_bool (bit), ret);
- }
+ scm_t_inum nn = SCM_I_INUM (n);
+ for (unsigned long i = 0; i < ll; i++)
+ ret = scm_cons (scm_from_bool (scm_integer_logbit_ui (i, nn)), ret);
}
else if (SCM_BIGP (n))
{
- for (i = 0; i < ll; i++)
- ret = scm_cons (scm_from_bool (mpz_tstbit (SCM_I_BIG_MPZ (n), i)),
- ret);
- scm_remember_upto_here_1 (n);
+ struct scm_bignum *nn = scm_bignum (n);
+ for (unsigned long i = 0; i < ll; i++)
+ ret = scm_cons (scm_from_bool (scm_integer_logbit_uz (i, nn)), ret);
}
else
SCM_WRONG_TYPE_ARG (SCM_ARG1, n);
@@ -388,16 +381,18 @@ SCM_DEFINE (scm_srfi60_list_to_integer, "list->integer", 1, 0, 0,
}
else
{
- /* need a bignum */
- SCM n = scm_i_ulong2big (0);
+ mpz_t z;
+ mpz_init (z);
while (scm_is_pair (lst))
{
len--;
if (! scm_is_false (SCM_CAR (lst)))
- mpz_setbit (SCM_I_BIG_MPZ (n), len);
+ mpz_setbit (z, len);
lst = SCM_CDR (lst);
}
- return n;
+ SCM ret = scm_from_mpz (z);
+ mpz_clear (z);
+ return ret;
}
}
#undef FUNC_NAME