mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 14:30:34 +02:00
Code Activity

Implement scm_logand with new integer library

Browse source 
* libguile/integers.c (scm_integer_logand_ii, scm_integer_logand_zi)
(scm_integer_logand_zz): New internal functions.
* libguile/integers.h: Declare the new internal functions.
* libguile/numbers.c (scm_logand): Use new internal functions.
This commit is contained in:
Andy Wingo 2021-12-19 10:03:31 +01:00
parent 6fa9fcb313
commit 4a380aa6ac
3 changed files with 79 additions and 33 deletions
Download patch file Download diff file Expand all files Collapse all files

70
libguile/integers.c
View file

@ -1854,3 +1854,73 @@ scm_integer_lcm_zz (SCM x, SCM y)
/* shouldn't need to normalize b/c lcm of 2 bigs should be big */
return take_mpz (result);
}
/* Emulating 2's complement bignums with sign magnitude arithmetic:
Logand:
X Y Result Method:
(len)
+ + + x (map digit:logand X Y)
+ - + x (map digit:logand X (lognot (+ -1 Y)))
- + + y (map digit:logand (lognot (+ -1 X)) Y)
- - - (+ 1 (map digit:logior (+ -1 X) (+ -1 Y)))
Logior:
X Y Result Method:
+ + + (map digit:logior X Y)
+ - - y (+ 1 (map digit:logand (lognot X) (+ -1 Y)))
- + - x (+ 1 (map digit:logand (+ -1 X) (lognot Y)))
- - - x (+ 1 (map digit:logand (+ -1 X) (+ -1 Y)))
Logxor:
X Y Result Method:
+ + + (map digit:logxor X Y)
+ - - (+ 1 (map digit:logxor X (+ -1 Y)))
- + - (+ 1 (map digit:logxor (+ -1 X) Y))
- - + (map digit:logxor (+ -1 X) (+ -1 Y))
Logtest:
X Y Result
+ + (any digit:logand X Y)
+ - (any digit:logand X (lognot (+ -1 Y)))
- + (any digit:logand (lognot (+ -1 X)) Y)
- - #t
*/
SCM
scm_integer_logand_ii (scm_t_inum x, scm_t_inum y)
{
return SCM_I_MAKINUM (x & y);
}
SCM
scm_integer_logand_zi (SCM x, scm_t_inum y)
{
if (y == 0)
return SCM_INUM0;
mpz_t result, zx, zy;
mpz_init (result);
alias_bignum_to_mpz (scm_bignum (x), zx);
mpz_init_set_si (zy, y);
mpz_and (result, zy, zx);
scm_remember_upto_here_1 (x);
mpz_clear (zy);
return take_mpz (result);
}
SCM
scm_integer_logand_zz (SCM x, SCM y)
{
mpz_t result, zx, zy;
mpz_init (result);
alias_bignum_to_mpz (scm_bignum (x), zx);
alias_bignum_to_mpz (scm_bignum (y), zy);
mpz_and (result, zx, zy);
scm_remember_upto_here_2 (x, y);
return take_mpz (result);
}

4
libguile/integers.h
View file

@ -132,6 +132,10 @@ SCM_INTERNAL SCM scm_integer_lcm_ii (scm_t_inum x, scm_t_inum y);
SCM_INTERNAL SCM scm_integer_lcm_zi (SCM x, scm_t_inum y);
SCM_INTERNAL SCM scm_integer_lcm_zz (SCM x, SCM y);
SCM_INTERNAL SCM scm_integer_logand_ii (scm_t_inum x, scm_t_inum y);
SCM_INTERNAL SCM scm_integer_logand_zi (SCM x, scm_t_inum y);
SCM_INTERNAL SCM scm_integer_logand_zz (SCM x, SCM y);
#endif /* SCM_INTEGERS_H */

38
libguile/numbers.c
View file

@ -2961,47 +2961,19 @@ SCM scm_logand (SCM n1, SCM n2)
if (SCM_I_INUMP (n1))
{
nn1 = SCM_I_INUM (n1);
if (SCM_I_INUMP (n2))
{
scm_t_inum nn2 = SCM_I_INUM (n2);
return SCM_I_MAKINUM (nn1 & nn2);
}
else if SCM_BIGP (n2)
{
intbig:
if (nn1 == 0)
return SCM_INUM0;
{
SCM result_z = scm_i_mkbig ();
mpz_t nn1_z;
mpz_init_set_si (nn1_z, nn1);
mpz_and (SCM_I_BIG_MPZ (result_z), nn1_z, SCM_I_BIG_MPZ (n2));
scm_remember_upto_here_1 (n2);
mpz_clear (nn1_z);
return scm_i_normbig (result_z);
}
}
return scm_integer_logand_ii (SCM_I_INUM (n1), SCM_I_INUM (n2));
else if (SCM_BIGP (n2))
return scm_integer_logand_zi (n2, SCM_I_INUM (n1));
else
SCM_WRONG_TYPE_ARG (SCM_ARG2, n2);
}
else if (SCM_BIGP (n1))
{
if (SCM_I_INUMP (n2))
{
SCM_SWAP (n1, n2);
nn1 = SCM_I_INUM (n1);
goto intbig;
}
return scm_integer_logand_zi (n1, SCM_I_INUM (n2));
else if (SCM_BIGP (n2))
{
SCM result_z = scm_i_mkbig ();
mpz_and (SCM_I_BIG_MPZ (result_z),
SCM_I_BIG_MPZ (n1),
SCM_I_BIG_MPZ (n2));
scm_remember_upto_here_2 (n1, n2);
return scm_i_normbig (result_z);
}
return scm_integer_logand_zz (n1, n2);
else
SCM_WRONG_TYPE_ARG (SCM_ARG2, n2);
}